{-|
Module      : GoPro.Plus.Media
Description : Functionality for managing media within GoPro Plus.
Copyright   : (c) Dustin Sallings, 2020
License     : BSD3
Maintainer  : dustin@spy.net
Stability   : experimental

GoPro Plus media client.
-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}

module GoPro.Plus.Media (
  -- * Accessing Data
  list, listAll, listWhile, medium,
  notReady,
  retrieve, delete, reprocess,
  fetchThumbnail,
  -- * Data Types
  PageInfo(..), current_page, per_page, total_items, total_pages,
  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,
  medium_token, medium_width, medium_height, medium_filename,
  Listing(..), media, pages,
  HasMediaURL(..), HasMediaHead(..), HasMediaLabel(..), HasMediaType(..), HasMediaItemNumber(..),
  File(..), file_camera_position, file_height, file_width,
  file_item_number, file_orientation, file_head, file_url, file_transforms,
  Variation(..), var_height, var_width, var_label, var_quality,
  var_type, var_transforms, var_head, var_url, var_item_number,
  SpriteFrame(..), frame_count, frame_height, frame_width,
  Sprite(..), sprite_fps, sprite_frame, sprite_height, sprite_width,
  sprite_type, sprite_heads, sprite_urls,
  SidecarFile(..), sidecar_fps, sidecar_label, sidecar_type, sidecar_head, sidecar_url, sidecar_item_number,
  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
  updateMedium, putMedium
  ) where

import           Control.Lens                 hiding ((.=))
import           Control.Monad.IO.Class       (MonadIO (..))
import           Data.Aeson                   (FromJSON (..), Options (..), ToJSON (..), Value (..), defaultOptions,
                                               fieldLabelModifier, genericParseJSON, genericToEncoding, genericToJSON,
                                               object, (.:), (.=))
import qualified Data.Aeson                   as J
import           Data.Aeson.Types             (typeMismatch)
import qualified Data.ByteString.Lazy         as BL
import           Data.Char                    (toLower)
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           Text.Read                    (readMaybe)

import           GoPro.Plus.Auth
import           GoPro.Plus.Internal.AuthHTTP
import           GoPro.Plus.Internal.HTTP

-- | Pagination info returned from lists.
data PageInfo = PageInfo
    { PageInfo -> Int
_current_page :: Int
    , PageInfo -> Int
_per_page     :: Int
    , PageInfo -> Int
_total_items  :: Int
    , PageInfo -> Int
_total_pages  :: Int
    }
    deriving (forall x. Rep PageInfo x -> PageInfo
forall x. PageInfo -> Rep PageInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageInfo x -> PageInfo
$cfrom :: forall x. PageInfo -> Rep PageInfo x
Generic, Int -> PageInfo -> ShowS
[PageInfo] -> ShowS
PageInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageInfo] -> ShowS
$cshowList :: [PageInfo] -> ShowS
show :: PageInfo -> String
$cshow :: PageInfo -> String
showsPrec :: Int -> PageInfo -> ShowS
$cshowsPrec :: Int -> PageInfo -> ShowS
Show, PageInfo -> PageInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageInfo -> PageInfo -> Bool
$c/= :: PageInfo -> PageInfo -> Bool
== :: PageInfo -> PageInfo -> Bool
$c== :: PageInfo -> PageInfo -> Bool
Eq)

makeLenses ''PageInfo

dropPrefix :: String -> (String -> String)
dropPrefix :: String -> ShowS
dropPrefix String
s = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)

instance FromJSON PageInfo where
  parseJSON :: Value -> Parser PageInfo
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOpts

instance ToJSON PageInfo where
  toEncoding :: PageInfo -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_" }
  toJSON :: PageInfo -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_" }

-- | GoPro-assigned identifier for an uploaded item.
type MediumID = T.Text

-- | 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
    | Chaptered
    | Livestream
    | Looped
    | LoopedVideo
    | BurstVideo
    | Continuous
    | ExternalVideo
    | Session
    | MultiClipEdit
    | Audio

    deriving (MediumType
forall a. a -> a -> Bounded a
maxBound :: MediumType
$cmaxBound :: MediumType
minBound :: MediumType
$cminBound :: MediumType
Bounded, Int -> MediumType
MediumType -> Int
MediumType -> [MediumType]
MediumType -> MediumType
MediumType -> MediumType -> [MediumType]
MediumType -> MediumType -> MediumType -> [MediumType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MediumType -> MediumType -> MediumType -> [MediumType]
$cenumFromThenTo :: MediumType -> MediumType -> MediumType -> [MediumType]
enumFromTo :: MediumType -> MediumType -> [MediumType]
$cenumFromTo :: MediumType -> MediumType -> [MediumType]
enumFromThen :: MediumType -> MediumType -> [MediumType]
$cenumFromThen :: MediumType -> MediumType -> [MediumType]
enumFrom :: MediumType -> [MediumType]
$cenumFrom :: MediumType -> [MediumType]
fromEnum :: MediumType -> Int
$cfromEnum :: MediumType -> Int
toEnum :: Int -> MediumType
$ctoEnum :: Int -> MediumType
pred :: MediumType -> MediumType
$cpred :: MediumType -> MediumType
succ :: MediumType -> MediumType
$csucc :: MediumType -> MediumType
Enum, Int -> MediumType -> ShowS
[MediumType] -> ShowS
MediumType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediumType] -> ShowS
$cshowList :: [MediumType] -> ShowS
show :: MediumType -> String
$cshow :: MediumType -> String
showsPrec :: Int -> MediumType -> ShowS
$cshowsPrec :: Int -> MediumType -> ShowS
Show, ReadPrec [MediumType]
ReadPrec MediumType
Int -> ReadS MediumType
ReadS [MediumType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MediumType]
$creadListPrec :: ReadPrec [MediumType]
readPrec :: ReadPrec MediumType
$creadPrec :: ReadPrec MediumType
readList :: ReadS [MediumType]
$creadList :: ReadS [MediumType]
readsPrec :: Int -> ReadS MediumType
$creadsPrec :: Int -> ReadS MediumType
Read, MediumType -> MediumType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediumType -> MediumType -> Bool
$c/= :: MediumType -> MediumType -> Bool
== :: MediumType -> MediumType -> Bool
$c== :: MediumType -> MediumType -> Bool
Eq)

instance ToJSON MediumType where
  toJSON :: MediumType -> Value
toJSON = Text -> Value
J.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance FromJSON MediumType where
  parseJSON :: Value -> Parser MediumType
parseJSON (J.String Text
x) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected MediumType: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
x)) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
x
  parseJSON Value
invalid      = forall a. String -> Value -> Parser a
typeMismatch String
"Response" Value
invalid

data ReadyToViewType = ViewReady
    | ViewFailure
    | ViewLoading
    | ViewRegistered
    | ViewTranscoding
    | ViewProcessing
    | ViewUploading
    | ViewPreTranscoding
    | ViewUpdating
    deriving (ReadyToViewType
forall a. a -> a -> Bounded a
maxBound :: ReadyToViewType
$cmaxBound :: ReadyToViewType
minBound :: ReadyToViewType
$cminBound :: ReadyToViewType
Bounded, Int -> ReadyToViewType
ReadyToViewType -> Int
ReadyToViewType -> [ReadyToViewType]
ReadyToViewType -> ReadyToViewType
ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
ReadyToViewType
-> ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReadyToViewType
-> ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
$cenumFromThenTo :: ReadyToViewType
-> ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
enumFromTo :: ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
$cenumFromTo :: ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
enumFromThen :: ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
$cenumFromThen :: ReadyToViewType -> ReadyToViewType -> [ReadyToViewType]
enumFrom :: ReadyToViewType -> [ReadyToViewType]
$cenumFrom :: ReadyToViewType -> [ReadyToViewType]
fromEnum :: ReadyToViewType -> Int
$cfromEnum :: ReadyToViewType -> Int
toEnum :: Int -> ReadyToViewType
$ctoEnum :: Int -> ReadyToViewType
pred :: ReadyToViewType -> ReadyToViewType
$cpred :: ReadyToViewType -> ReadyToViewType
succ :: ReadyToViewType -> ReadyToViewType
$csucc :: ReadyToViewType -> ReadyToViewType
Enum, Int -> ReadyToViewType -> ShowS
[ReadyToViewType] -> ShowS
ReadyToViewType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadyToViewType] -> ShowS
$cshowList :: [ReadyToViewType] -> ShowS
show :: ReadyToViewType -> String
$cshow :: ReadyToViewType -> String
showsPrec :: Int -> ReadyToViewType -> ShowS
$cshowsPrec :: Int -> ReadyToViewType -> ShowS
Show, ReadPrec [ReadyToViewType]
ReadPrec ReadyToViewType
Int -> ReadS ReadyToViewType
ReadS [ReadyToViewType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReadyToViewType]
$creadListPrec :: ReadPrec [ReadyToViewType]
readPrec :: ReadPrec ReadyToViewType
$creadPrec :: ReadPrec ReadyToViewType
readList :: ReadS [ReadyToViewType]
$creadList :: ReadS [ReadyToViewType]
readsPrec :: Int -> ReadS ReadyToViewType
$creadsPrec :: Int -> ReadS ReadyToViewType
Read, forall x. Rep ReadyToViewType x -> ReadyToViewType
forall x. ReadyToViewType -> Rep ReadyToViewType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadyToViewType x -> ReadyToViewType
$cfrom :: forall x. ReadyToViewType -> Rep ReadyToViewType x
Generic, ReadyToViewType -> ReadyToViewType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadyToViewType -> ReadyToViewType -> Bool
$c/= :: ReadyToViewType -> ReadyToViewType -> Bool
== :: ReadyToViewType -> ReadyToViewType -> Bool
$c== :: ReadyToViewType -> ReadyToViewType -> Bool
Eq)

instance ToJSON ReadyToViewType where
  toEncoding :: ReadyToViewType -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ constructorTagModifier :: ShowS
constructorTagModifier = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropPrefix String
"View"}
  toJSON :: ReadyToViewType -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ constructorTagModifier :: ShowS
constructorTagModifier = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropPrefix String
"View"}


instance FromJSON ReadyToViewType where
  parseJSON :: Value -> Parser ReadyToViewType
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOpts{ constructorTagModifier :: ShowS
constructorTagModifier = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropPrefix String
"View"}

data Medium = Medium
    { Medium -> Text
_medium_id              :: MediumID
    , Medium -> Maybe String
_medium_camera_model    :: Maybe String
    , Medium -> UTCTime
_medium_captured_at     :: UTCTime
    , Medium -> UTCTime
_medium_created_at      :: UTCTime
    , Medium -> Maybe Int
_medium_file_size       :: Maybe Int
    , Medium -> Int
_medium_moments_count   :: Int
    , Medium -> ReadyToViewType
_medium_ready_to_view   :: ReadyToViewType
    , Medium -> Maybe String
_medium_source_duration :: Maybe String
    , Medium -> MediumType
_medium_type            :: MediumType
    , Medium -> String
_medium_token           :: String
    , Medium -> Maybe Int
_medium_width           :: Maybe Int
    , Medium -> Maybe Int
_medium_height          :: Maybe Int
    , Medium -> Maybe String
_medium_filename        :: Maybe String
    }
    deriving (forall x. Rep Medium x -> Medium
forall x. Medium -> Rep Medium x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Medium x -> Medium
$cfrom :: forall x. Medium -> Rep Medium x
Generic, Medium -> Medium -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Medium -> Medium -> Bool
$c/= :: Medium -> Medium -> Bool
== :: Medium -> Medium -> Bool
$c== :: Medium -> Medium -> Bool
Eq, Int -> Medium -> ShowS
[Medium] -> ShowS
Medium -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Medium] -> ShowS
$cshowList :: [Medium] -> ShowS
show :: Medium -> String
$cshow :: Medium -> String
showsPrec :: Int -> Medium -> ShowS
$cshowsPrec :: Int -> Medium -> ShowS
Show)

makeLenses ''Medium

mediumMod :: String -> String
mediumMod :: ShowS
mediumMod = String -> ShowS
dropPrefix String
"_medium_"

instance ToJSON Medium where
  toEncoding :: Medium -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
mediumMod}
  toJSON :: Medium -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
mediumMod}

instance FromJSON Medium where
  parseJSON :: Value -> Parser Medium
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
mediumMod}

-- | Get the thumbnail token for a given medium result.
thumbnailURL :: Int    -- ^ Server ID [1..4]
             -> Medium -- ^ The Medium whose thumbnail is requested
             -> String -- ^ A URL to a ~450 pixel wide thumbnail
thumbnailURL :: Int -> Medium -> String
thumbnailURL Int
n Medium{String
_medium_token :: String
_medium_token :: Medium -> String
_medium_token} = String
"https://images-0" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
".gopro.com/resize/450wwp/" forall a. Semigroup a => a -> a -> a
<> String
_medium_token

-- | Fetch a 450px wide thumbnail data for the given medium.
fetchThumbnail :: (HasGoProAuth m, MonadIO m) => Medium -> m BL.ByteString
fetchThumbnail :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Medium -> m ByteString
fetchThumbnail Medium
m = do
  Int
n <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom (forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
1,Int
4))
  forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
String -> m ByteString
proxyAuth (Int -> Medium -> String
thumbnailURL Int
n Medium
m)

data Listing = Listing
    { Listing -> [Medium]
_media :: [Medium]
    , Listing -> PageInfo
_pages :: PageInfo
    }
    deriving (forall x. Rep Listing x -> Listing
forall x. Listing -> Rep Listing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Listing x -> Listing
$cfrom :: forall x. Listing -> Rep Listing x
Generic, Listing -> Listing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Listing -> Listing -> Bool
$c/= :: Listing -> Listing -> Bool
== :: Listing -> Listing -> Bool
$c== :: Listing -> Listing -> Bool
Eq, Int -> Listing -> ShowS
[Listing] -> ShowS
Listing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Listing] -> ShowS
$cshowList :: [Listing] -> ShowS
show :: Listing -> String
$cshow :: Listing -> String
showsPrec :: Int -> Listing -> ShowS
$cshowsPrec :: Int -> Listing -> ShowS
Show)

makeLenses ''Listing

instance FromJSON Listing where
  parseJSON :: Value -> Parser Listing
parseJSON (Object Object
v) = do
    Object
o <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_embedded"
    Vector Value
m <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"media"
    [Medium]
ms <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON (forall a. Vector a -> [a]
V.toList Vector Value
m)
    [Medium] -> PageInfo -> Listing
Listing [Medium]
ms forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_pages"
  parseJSON Value
invalid    = forall a. String -> Value -> Parser a
typeMismatch String
"Response" Value
invalid

instance ToJSON Listing where
  toJSON :: Listing -> Value
toJSON Listing{[Medium]
PageInfo
_pages :: PageInfo
_media :: [Medium]
_pages :: Listing -> PageInfo
_media :: Listing -> [Medium]
..} = [Pair] -> Value
object [Key
"_embedded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"media" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Medium]
_media], Key
"_pages" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PageInfo
_pages]

-- | List a page worth of media.
list :: (HasGoProAuth m, MonadIO m)
  => Int -- ^ Number of items per page.
  -> Int -- ^ Page number (one-based).
  -> m ([Medium], PageInfo)
list :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Int -> m ([Medium], PageInfo)
list Int
psize Int
page = do
  Listing
r <- forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, FromJSON a) =>
String -> m a
jgetAuth (String
"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=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
psize forall a. Semigroup a => a -> a -> a
<> String
"&page=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
page)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Listing
r forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Lens' Listing [Medium]
media forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded,
        Listing
r forall s a. s -> Getting a s a -> a
^. Lens' Listing PageInfo
pages)

-- | List all media.
listAll :: (HasGoProAuth m, MonadIO m) => m [Medium]
listAll :: forall (m :: * -> *). (HasGoProAuth m, MonadIO m) => m [Medium]
listAll = forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
([Medium] -> Bool) -> m [Medium]
listWhile (forall a b. a -> b -> a
const Bool
True)

-- | List all media while returned batches pass the given predicate.
listWhile :: (HasGoProAuth m, MonadIO m) => ([Medium] -> Bool) -> m [Medium]
listWhile :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
([Medium] -> Bool) -> m [Medium]
listWhile [Medium] -> Bool
f = forall k a. Map k a -> [a]
Map.elems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
(HasGoProAuth m, MonadIO m) =>
Int -> Map Text Medium -> m (Map Text Medium)
dig Int
1 forall a. Monoid a => a
mempty
    where
      dig :: Int -> Map Text Medium -> m (Map Text Medium)
dig Int
n Map Text Medium
m = do
        ([Medium]
ms, PageInfo
_) <- forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Int -> m ([Medium], PageInfo)
list Int
100 Int
n
        let m' :: Map Text Medium
m' = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Medium
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\md :: Medium
md@Medium{Int
String
Maybe Int
Maybe String
UTCTime
Text
ReadyToViewType
MediumType
_medium_filename :: Maybe String
_medium_height :: Maybe Int
_medium_width :: Maybe Int
_medium_token :: String
_medium_type :: MediumType
_medium_source_duration :: Maybe String
_medium_ready_to_view :: ReadyToViewType
_medium_moments_count :: Int
_medium_file_size :: Maybe Int
_medium_created_at :: UTCTime
_medium_captured_at :: UTCTime
_medium_camera_model :: Maybe String
_medium_id :: Text
_medium_filename :: Medium -> Maybe String
_medium_height :: Medium -> Maybe Int
_medium_width :: Medium -> Maybe Int
_medium_token :: Medium -> String
_medium_type :: Medium -> MediumType
_medium_source_duration :: Medium -> Maybe String
_medium_ready_to_view :: Medium -> ReadyToViewType
_medium_moments_count :: Medium -> Int
_medium_file_size :: Medium -> Maybe Int
_medium_created_at :: Medium -> UTCTime
_medium_captured_at :: Medium -> UTCTime
_medium_camera_model :: Medium -> Maybe String
_medium_id :: Medium -> Text
..} -> (Text
_medium_id, Medium
md)) forall a b. (a -> b) -> a -> b
$ [Medium]
ms
        if (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Medium]
ms Bool -> Bool -> Bool
&& [Medium] -> Bool
f [Medium]
ms
          then Int -> Map Text Medium -> m (Map Text Medium)
dig (Int
n forall a. Num a => a -> a -> a
+ Int
1) Map Text Medium
m'
          else forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Medium
m'

-- | Get a list of items whose processing is failed or incomplete.
--
-- This includes items that are currently uploading, or items that will not upload.
notReady :: (HasGoProAuth m, MonadIO m) => m [Medium]
notReady :: forall (m :: * -> *). (HasGoProAuth m, MonadIO m) => m [Medium]
notReady = forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' Listing [Medium]
media forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, FromJSON a) =>
String -> m a
jgetAuth String
"https://api.gopro.com/media/filters/not-ready?page=1&per_page=200"

class HasMediaURL c where
  media_url :: Lens' c String

class HasMediaHead c where
  media_head :: Lens' c String

class HasMediaLabel c where
  media_label :: Lens' c String

class HasMediaType c where
  media_type :: Lens' c String

class HasMediaItemNumber c where
  media_item_number :: Lens' c (Maybe Int)

data File = File
    { File -> String
_file_camera_position :: String
    , File -> Int
_file_height          :: Int
    , File -> Int
_file_width           :: Int
    , File -> Int
_file_item_number     :: Int
    , File -> Int
_file_orientation     :: Int
    , File -> Maybe [String]
_file_transforms      :: Maybe [String]
    , File -> String
_file_head            :: String
    , File -> String
_file_url             :: String
    }
    deriving (forall x. Rep File x -> File
forall x. File -> Rep File x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep File x -> File
$cfrom :: forall x. File -> Rep File x
Generic, File -> File -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq, Int -> File -> ShowS
[File] -> ShowS
File -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show)

makeLenses  ''File

instance HasMediaURL File where media_url :: Lens' File String
media_url = Lens' File String
file_url
instance HasMediaHead File where media_head :: Lens' File String
media_head = Lens' File String
file_head

instance HasMediaItemNumber File where
  media_item_number :: Lens' File (Maybe Int)
media_item_number = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
                        (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. File -> Int
_file_item_number)
                        (\File
f -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe File
f (\Int
x -> File
f{_file_item_number :: Int
_file_item_number=Int
x}))

instance FromJSON File where
  parseJSON :: Value -> Parser File
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
    fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_file_"
    }

instance ToJSON File where
  toEncoding :: File -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_file_" }
  toJSON :: File -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_file_" }

data Variation = Variation
    { Variation -> Int
_var_height      :: Int
    , Variation -> Int
_var_width       :: Int
    , Variation -> String
_var_label       :: String
    , Variation -> String
_var_quality     :: String
    , Variation -> Maybe [String]
_var_transforms  :: Maybe [String]
    , Variation -> Maybe Int
_var_item_number :: Maybe Int
    , Variation -> String
_var_type        :: String
    , Variation -> String
_var_head        :: String
    , Variation -> String
_var_url         :: String
    }
    deriving (forall x. Rep Variation x -> Variation
forall x. Variation -> Rep Variation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Variation x -> Variation
$cfrom :: forall x. Variation -> Rep Variation x
Generic, Variation -> Variation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variation -> Variation -> Bool
$c/= :: Variation -> Variation -> Bool
== :: Variation -> Variation -> Bool
$c== :: Variation -> Variation -> Bool
Eq, Int -> Variation -> ShowS
[Variation] -> ShowS
Variation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variation] -> ShowS
$cshowList :: [Variation] -> ShowS
show :: Variation -> String
$cshow :: Variation -> String
showsPrec :: Int -> Variation -> ShowS
$cshowsPrec :: Int -> Variation -> ShowS
Show)

makeLenses ''Variation

instance HasMediaURL Variation where media_url :: Lens' Variation String
media_url = Lens' Variation String
var_url
instance HasMediaHead Variation where media_head :: Lens' Variation String
media_head = Lens' Variation String
var_head
instance HasMediaLabel Variation where media_label :: Lens' Variation String
media_label = Lens' Variation String
var_label
instance HasMediaType Variation where media_type :: Lens' Variation String
media_type = Lens' Variation String
var_type
instance HasMediaItemNumber Variation where media_item_number :: Lens' Variation (Maybe Int)
media_item_number = Lens' Variation (Maybe Int)
var_item_number

instance FromJSON Variation where
  parseJSON :: Value -> Parser Variation
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
  fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_var_"
  }

instance ToJSON Variation where
  toEncoding :: Variation -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_var_" }
  toJSON :: Variation -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_var_" }

data SpriteFrame = SpriteFrame
    { SpriteFrame -> Int
_frame_count  :: Int
    , SpriteFrame -> Int
_frame_height :: Int
    , SpriteFrame -> Int
_frame_width  :: Int
    }
    deriving (forall x. Rep SpriteFrame x -> SpriteFrame
forall x. SpriteFrame -> Rep SpriteFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpriteFrame x -> SpriteFrame
$cfrom :: forall x. SpriteFrame -> Rep SpriteFrame x
Generic, SpriteFrame -> SpriteFrame -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpriteFrame -> SpriteFrame -> Bool
$c/= :: SpriteFrame -> SpriteFrame -> Bool
== :: SpriteFrame -> SpriteFrame -> Bool
$c== :: SpriteFrame -> SpriteFrame -> Bool
Eq, Int -> SpriteFrame -> ShowS
[SpriteFrame] -> ShowS
SpriteFrame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpriteFrame] -> ShowS
$cshowList :: [SpriteFrame] -> ShowS
show :: SpriteFrame -> String
$cshow :: SpriteFrame -> String
showsPrec :: Int -> SpriteFrame -> ShowS
$cshowsPrec :: Int -> SpriteFrame -> ShowS
Show)

makeLenses ''SpriteFrame

instance FromJSON SpriteFrame where
  parseJSON :: Value -> Parser SpriteFrame
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
    fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_frame_"
  }

instance ToJSON SpriteFrame where
  toEncoding :: SpriteFrame -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_frame_" }
  toJSON :: SpriteFrame -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_frame_" }

data Sprite = Sprite
    { Sprite -> Double
_sprite_fps    :: Double
    , Sprite -> SpriteFrame
_sprite_frame  :: SpriteFrame
    , Sprite -> Int
_sprite_height :: Int
    , Sprite -> Int
_sprite_width  :: Int
    , Sprite -> String
_sprite_type   :: String
    , Sprite -> [String]
_sprite_heads  :: [String]
    , Sprite -> [String]
_sprite_urls   :: [String]
    }
    deriving (forall x. Rep Sprite x -> Sprite
forall x. Sprite -> Rep Sprite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sprite x -> Sprite
$cfrom :: forall x. Sprite -> Rep Sprite x
Generic, Sprite -> Sprite -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sprite -> Sprite -> Bool
$c/= :: Sprite -> Sprite -> Bool
== :: Sprite -> Sprite -> Bool
$c== :: Sprite -> Sprite -> Bool
Eq, Int -> Sprite -> ShowS
[Sprite] -> ShowS
Sprite -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sprite] -> ShowS
$cshowList :: [Sprite] -> ShowS
show :: Sprite -> String
$cshow :: Sprite -> String
showsPrec :: Int -> Sprite -> ShowS
$cshowsPrec :: Int -> Sprite -> ShowS
Show)

makeLenses ''Sprite

instance FromJSON Sprite where
  parseJSON :: Value -> Parser Sprite
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
    fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_sprite_"
  }

instance ToJSON Sprite where
  toEncoding :: Sprite -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_sprite_" }
  toJSON :: Sprite -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_sprite_" }

data SidecarFile = SidecarFile
  { SidecarFile -> Double
_sidecar_fps         :: Double
  , SidecarFile -> String
_sidecar_label       :: String
  , SidecarFile -> String
_sidecar_type        :: String
  , SidecarFile -> String
_sidecar_head        :: String
  , SidecarFile -> String
_sidecar_url         :: String
  , SidecarFile -> Maybe Int
_sidecar_item_number :: Maybe Int
  } deriving (forall x. Rep SidecarFile x -> SidecarFile
forall x. SidecarFile -> Rep SidecarFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SidecarFile x -> SidecarFile
$cfrom :: forall x. SidecarFile -> Rep SidecarFile x
Generic, SidecarFile -> SidecarFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SidecarFile -> SidecarFile -> Bool
$c/= :: SidecarFile -> SidecarFile -> Bool
== :: SidecarFile -> SidecarFile -> Bool
$c== :: SidecarFile -> SidecarFile -> Bool
Eq, Int -> SidecarFile -> ShowS
[SidecarFile] -> ShowS
SidecarFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SidecarFile] -> ShowS
$cshowList :: [SidecarFile] -> ShowS
show :: SidecarFile -> String
$cshow :: SidecarFile -> String
showsPrec :: Int -> SidecarFile -> ShowS
$cshowsPrec :: Int -> SidecarFile -> ShowS
Show)

makeLenses ''SidecarFile

instance HasMediaURL SidecarFile where media_url :: Lens' SidecarFile String
media_url = Lens' SidecarFile String
sidecar_url
instance HasMediaHead SidecarFile where media_head :: Lens' SidecarFile String
media_head = Lens' SidecarFile String
sidecar_head
instance HasMediaLabel SidecarFile where media_label :: Lens' SidecarFile String
media_label = Lens' SidecarFile String
sidecar_label
instance HasMediaType SidecarFile where media_type :: Lens' SidecarFile String
media_type = Lens' SidecarFile String
sidecar_type
instance HasMediaItemNumber SidecarFile where media_item_number :: Lens' SidecarFile (Maybe Int)
media_item_number = Lens' SidecarFile (Maybe Int)
sidecar_item_number

instance FromJSON SidecarFile where
  parseJSON :: Value -> Parser SidecarFile
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
    fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_sidecar_"
  }

instance ToJSON SidecarFile where
  toEncoding :: SidecarFile -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_sidecar_" }
  toJSON :: SidecarFile -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_sidecar_" }

data FileStuff = FileStuff
    { FileStuff -> [File]
_files         :: [File]
    , FileStuff -> [Variation]
_variations    :: [Variation]
    , FileStuff -> [Sprite]
_sprites       :: [Sprite]
    , FileStuff -> [SidecarFile]
_sidecar_files :: [SidecarFile]
    }
    deriving (forall x. Rep FileStuff x -> FileStuff
forall x. FileStuff -> Rep FileStuff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileStuff x -> FileStuff
$cfrom :: forall x. FileStuff -> Rep FileStuff x
Generic, FileStuff -> FileStuff -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileStuff -> FileStuff -> Bool
$c/= :: FileStuff -> FileStuff -> Bool
== :: FileStuff -> FileStuff -> Bool
$c== :: FileStuff -> FileStuff -> Bool
Eq, Int -> FileStuff -> ShowS
[FileStuff] -> ShowS
FileStuff -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileStuff] -> ShowS
$cshowList :: [FileStuff] -> ShowS
show :: FileStuff -> String
$cshow :: FileStuff -> String
showsPrec :: Int -> FileStuff -> ShowS
$cshowsPrec :: Int -> FileStuff -> ShowS
Show)

makeLenses ''FileStuff

instance FromJSON FileStuff where
  parseJSON :: Value -> Parser FileStuff
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOpts

instance ToJSON FileStuff where
  toEncoding :: FileStuff -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_" }
  toJSON :: FileStuff -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_" }

data FileInfo = FileInfo
    { FileInfo -> FileStuff
_fileStuff :: FileStuff
    , FileInfo -> String
_filename  :: String
    }
    deriving (forall x. Rep FileInfo x -> FileInfo
forall x. FileInfo -> Rep FileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileInfo x -> FileInfo
$cfrom :: forall x. FileInfo -> Rep FileInfo x
Generic, FileInfo -> FileInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileInfo -> FileInfo -> Bool
$c/= :: FileInfo -> FileInfo -> Bool
== :: FileInfo -> FileInfo -> Bool
$c== :: FileInfo -> FileInfo -> Bool
Eq, Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileInfo] -> ShowS
$cshowList :: [FileInfo] -> ShowS
show :: FileInfo -> String
$cshow :: FileInfo -> String
showsPrec :: Int -> FileInfo -> ShowS
$cshowsPrec :: Int -> FileInfo -> ShowS
Show)

makeLenses ''FileInfo

instance FromJSON FileInfo where
  parseJSON :: Value -> Parser FileInfo
parseJSON (Object Object
v) = do
    Value
o <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_embedded"
    FileStuff
fs <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
    FileStuff -> String -> FileInfo
FileInfo FileStuff
fs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filename"
  parseJSON Value
invalid    = forall a. String -> Value -> Parser a
typeMismatch String
"Response" Value
invalid

instance ToJSON FileInfo where
  toJSON :: FileInfo -> Value
toJSON FileInfo{String
FileStuff
_filename :: String
_fileStuff :: FileStuff
_filename :: FileInfo -> String
_fileStuff :: FileInfo -> FileStuff
..} = [Pair] -> Value
object [Key
"_embedded" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FileStuff
_fileStuff, Key
"filename" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
_filename]

dlURL :: MediumID -> String
dlURL :: Text -> String
dlURL Text
k = String
"https://api.gopro.com/media/" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
k forall a. Semigroup a => a -> a -> a
<> String
"/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 :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j
retrieve :: forall (m :: * -> *) j.
(HasGoProAuth m, FromJSON j, MonadIO m) =>
Text -> m j
retrieve Text
k = forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, FromJSON a) =>
String -> m a
jgetAuth (Text -> String
dlURL Text
k)

data Error = Error
    { Error -> String
_error_reason      :: String
    , Error -> Int
_error_code        :: Int
    , Error -> String
_error_description :: String
    , Error -> String
_error_id          :: String
    }
    deriving (forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

makeLenses ''Error

instance FromJSON Error where
  parseJSON :: Value -> Parser Error
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
    fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_error_"
  }

newtype Errors = Errors [Error] deriving (Int -> Errors -> ShowS
[Errors] -> ShowS
Errors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Errors] -> ShowS
$cshowList :: [Errors] -> ShowS
show :: Errors -> String
$cshow :: Errors -> String
showsPrec :: Int -> Errors -> ShowS
$cshowsPrec :: Int -> Errors -> ShowS
Show)

instance FromJSON Errors where
  parseJSON :: Value -> Parser Errors
parseJSON (Object Object
v) = do
    Object
o <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_embedded"
    Value
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"errors"
    [Error] -> Errors
Errors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
e
  parseJSON Value
invalid    = forall a. String -> Value -> Parser a
typeMismatch String
"Response" Value
invalid

-- | Delete an item.
delete :: (HasGoProAuth m, MonadIO m) => MediumID -> m [Error]
delete :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> m [Error]
delete Text
k = do
  Text
tok <- AuthInfo -> Text
_access_token forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
  let u :: Text
u = Text
"https://api.gopro.com/media?ids=" forall a. Semigroup a => a -> a -> a
<> Text
k
  Errors [Error]
r <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Options -> String -> IO (Response ByteString)
deleteWith (Text -> Options
authOpts Text
tok) (Text -> String
T.unpack Text
u) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
asJSON)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure [Error]
r

mediumURL :: MediumID -> String
mediumURL :: Text -> String
mediumURL = (String
"https://api.gopro.com/media/" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | Get the current 'Medium' record for the given Medium ID.
medium :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j
medium :: forall (m :: * -> *) j.
(HasGoProAuth m, FromJSON j, MonadIO m) =>
Text -> m j
medium = forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, FromJSON a) =>
String -> m a
jgetAuth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
mediumURL

-- | Reprocess a failed upload for the given medium ID
reprocess :: (HasGoProAuth m, MonadIO m) => MediumID -> m ()
reprocess :: forall (m :: * -> *). (HasGoProAuth m, MonadIO m) => Text -> m ()
reprocess Text
mid = forall (m :: * -> *) j a.
(HasGoProAuth m, MonadIO m, FromJSON j, Putable a) =>
String -> a -> m j
jputAuth (Text -> String
mediumURL Text
mid forall a. Semigroup a => a -> a -> a
<> String
"/process") ByteString
BL.empty

-- | 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 :: forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, Putable a) =>
Text -> a -> m ()
putMedium Text
mid = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ()
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) j a.
(HasGoProAuth m, MonadIO m, FromJSON j, Putable a) =>
String -> a -> m j
jputAuth (Text -> String
mediumURL Text
mid)
  where
    v :: Value -> ()
    v :: Value -> ()
v = forall a b. a -> b -> a
const ()

-- | Fetch, modify, and store a medium value.
updateMedium :: (HasGoProAuth m, MonadIO m, FromJSON j, Putable a)
             => (j -> a) -- ^ Transformation function.
             -> MediumID -- ^ Medium to update.
             -> m ()
updateMedium :: forall (m :: * -> *) j a.
(HasGoProAuth m, MonadIO m, FromJSON j, Putable a) =>
(j -> a) -> Text -> m ()
updateMedium j -> a
f Text
m = (j -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) j.
(HasGoProAuth m, FromJSON j, MonadIO m) =>
Text -> m j
medium Text
m) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, Putable a) =>
Text -> a -> m ()
putMedium Text
m

-- | A moment of interestingness in a Medium.
data Moment = Moment
    { Moment -> Text
_moment_id   :: T.Text
    , Moment -> Maybe Int
_moment_time :: Maybe Int
    }
    deriving (Int -> Moment -> ShowS
[Moment] -> ShowS
Moment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Moment] -> ShowS
$cshowList :: [Moment] -> ShowS
show :: Moment -> String
$cshow :: Moment -> String
showsPrec :: Int -> Moment -> ShowS
$cshowsPrec :: Int -> Moment -> ShowS
Show, Moment -> Moment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Moment -> Moment -> Bool
$c/= :: Moment -> Moment -> Bool
== :: Moment -> Moment -> Bool
$c== :: Moment -> Moment -> Bool
Eq, forall x. Rep Moment x -> Moment
forall x. Moment -> Rep Moment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Moment x -> Moment
$cfrom :: forall x. Moment -> Rep Moment x
Generic)

makeLenses ''Moment

instance FromJSON Moment where
  parseJSON :: Value -> Parser Moment
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {
    fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_moment_"
  }

instance ToJSON Moment where
  toEncoding :: Moment -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_moment_" }
  toJSON :: Moment -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOpts{ fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
dropPrefix String
"_moment_" }

newtype Moments = Moments { Moments -> [Moment]
unMoments :: [Moment] }

instance FromJSON Moments where
  parseJSON :: Value -> Parser Moments
parseJSON (Object Object
v) = do
    Object
o <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_embedded"
    Vector Value
m <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"moments"
    [Moment] -> Moments
Moments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromJSON a => Value -> Parser a
parseJSON (forall a. Vector a -> [a]
V.toList Vector Value
m)

  parseJSON Value
invalid    = forall a. String -> Value -> Parser a
typeMismatch String
"Response" Value
invalid

-- | Get the moments for the given medium.
moments :: (HasGoProAuth m, MonadIO m) => MediumID -> m [Moment]
moments :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> m [Moment]
moments Text
mid = Moments -> [Moment]
unMoments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, FromJSON a) =>
String -> m a
jgetAuth (String
"https://api.gopro.com/media/" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
mid forall a. Semigroup a => a -> a -> a
<> String
"/moments?fields=time")