{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module GoPro.Plus.Upload (
uploadMedium,
runUpload, resumeUpload,
createMedium, createSource, createDerivative, createUpload,
completeUpload, getUpload, uploadChunk, markAvailable,
UploadID, DerivativeID,
UploadPart(..), uploadLength, uploadPart, uploadURL,
Upload(..), uploadID, uploadParts,
Uploader,
setMediumType, setLogAction,
listUploading
) where
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 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 GoPro.Plus.Auth (AuthInfo (..), HasGoProAuth (..))
import GoPro.Plus.Internal.AuthHTTP
import GoPro.Plus.Internal.HTTP
import GoPro.Plus.Media (Medium (..), MediumID, MediumType (..), ReadyToViewType (..), list,
putMedium)
type UploadID = T.Text
type DerivativeID = T.Text
type Uploader m = StateT (Env m) m
instance MonadUnliftIO m => MonadUnliftIO (StateT (Env m) m) where
withRunInIO :: ((forall a. StateT (Env m) m a -> IO a) -> IO b)
-> StateT (Env m) m b
withRunInIO (forall a. StateT (Env m) m a -> IO a) -> IO b
inner =
StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get StateT (Env m) m (Env m)
-> (Env m -> StateT (Env m) m b) -> StateT (Env m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env m
st -> (Env m -> m (b, Env m)) -> StateT (Env m) m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Env m -> m (b, Env m)) -> StateT (Env m) m b)
-> (Env m -> m (b, Env m)) -> StateT (Env m) m b
forall a b. (a -> b) -> a -> b
$ \Env m
_ ->
((forall a. m a -> IO a) -> IO (b, Env m)) -> m (b, Env m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (b, Env m)) -> m (b, Env m))
-> ((forall a. m a -> IO a) -> IO (b, Env m)) -> m (b, Env m)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (,Env m
st) (b -> (b, Env m)) -> IO b -> IO (b, Env m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. StateT (Env m) m a -> IO a) -> IO b
inner (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (StateT (Env m) m a -> m a) -> StateT (Env m) m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (Env m) m a -> Env m -> m a)
-> Env m -> StateT (Env m) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Env m) m a -> Env m -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Env m
st)
instance HasGoProAuth m => HasGoProAuth (Uploader m) where
goproAuth :: Uploader m AuthInfo
goproAuth = m AuthInfo -> Uploader m AuthInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
data Env m = Env {
Env m -> [FilePath]
fileList :: [FilePath],
Env m -> MediumType
mediumType :: MediumType,
Env m -> Text
extension :: T.Text,
Env m -> FilePath
filename :: String,
Env m -> Text
mediumID :: MediumID,
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => String -> m ()
}
listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium]
listUploading :: m [Medium]
listUploading = (Medium -> Bool) -> [Medium] -> [Medium]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Medium{Int
FilePath
Maybe Int
Maybe FilePath
Text
UTCTime
ReadyToViewType
MediumType
_medium_height :: Medium -> Maybe Int
_medium_width :: Medium -> Maybe Int
_medium_token :: Medium -> FilePath
_medium_type :: Medium -> MediumType
_medium_source_duration :: Medium -> Maybe FilePath
_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 FilePath
_medium_id :: Medium -> Text
_medium_height :: Maybe Int
_medium_width :: Maybe Int
_medium_token :: FilePath
_medium_type :: MediumType
_medium_source_duration :: Maybe FilePath
_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 FilePath
_medium_id :: Text
..} -> ReadyToViewType
_medium_ready_to_view ReadyToViewType -> ReadyToViewType -> Bool
forall a. Eq a => a -> a -> Bool
== ReadyToViewType
ViewUploading) ([Medium] -> [Medium])
-> (([Medium], PageInfo) -> [Medium])
-> ([Medium], PageInfo)
-> [Medium]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Medium], PageInfo) -> [Medium]
forall a b. (a, b) -> a
fst (([Medium], PageInfo) -> [Medium])
-> m ([Medium], PageInfo) -> m [Medium]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> m ([Medium], PageInfo)
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Int -> m ([Medium], PageInfo)
list Int
30 Int
1
runUpload :: (HasGoProAuth m, MonadFail m, MonadIO m)
=> [FilePath]
-> Uploader m a
-> m a
runUpload :: [FilePath] -> Uploader m a -> m a
runUpload [FilePath]
fileList = [FilePath] -> Text -> Uploader m a -> m a
forall (m :: * -> *) a.
(HasGoProAuth m, MonadFail m, MonadIO m) =>
[FilePath] -> Text -> Uploader m a -> m a
resumeUpload [FilePath]
fileList Text
""
resumeUpload :: (HasGoProAuth m, MonadFail m, MonadIO m) => [FilePath] -> MediumID -> Uploader m a -> m a
resumeUpload :: [FilePath] -> Text -> Uploader m a -> m a
resumeUpload [] Text
_ Uploader m a
_ = FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"empty file list"
resumeUpload fileList :: [FilePath]
fileList@(FilePath
fp:[FilePath]
_) Text
mediumID Uploader m a
a =
m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth m AuthInfo -> (AuthInfo -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AuthInfo{Int
Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
..} -> Uploader m a -> Env m -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Uploader m a
a Env :: forall (m :: * -> *).
[FilePath]
-> MediumType
-> Text
-> FilePath
-> Text
-> ((MonadMask m, Monad m) => FilePath -> m ())
-> Env m
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
forall (f :: * -> *) p. Applicative f => p -> f ()
logAction :: forall (f :: * -> *) p. Applicative f => p -> f ()
mediumType :: MediumType
filename :: FilePath
extension :: Text
mediumID :: Text
fileList :: [FilePath]
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
..}
where
extension :: Text
extension = FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
filename
filename :: FilePath
filename = FilePath -> FilePath
takeFileName FilePath
fp
mediumType :: MediumType
mediumType = Text -> MediumType
forall a. (Eq a, IsString a) => a -> MediumType
fileType Text
extension
logAction :: p -> f ()
logAction p
_ = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
fileType :: a -> MediumType
fileType a
"JPG" = MediumType
Photo
fileType a
_ = MediumType
Video
setMediumType :: Monad m => MediumType -> Uploader m ()
setMediumType :: MediumType -> Uploader m ()
setMediumType MediumType
t = (Env m -> Env m) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
m -> Env m
m{mediumType :: MediumType
mediumType=MediumType
t})
setLogAction :: (Monad m, MonadMask m) => (String -> m ()) -> Uploader m ()
setLogAction :: (FilePath -> m ()) -> Uploader m ()
setLogAction FilePath -> m ()
t = (Env m -> Env m) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
m -> Env m
m{logAction :: (MonadMask m, Monad m) => FilePath -> m ()
logAction=FilePath -> m ()
(MonadMask m, Monad m) => FilePath -> m ()
t})
jpostVal :: (HasGoProAuth m, MonadIO m) => Options -> String -> J.Value -> m J.Value
jpostVal :: Options -> FilePath -> Value -> m Value
jpostVal Options
opts FilePath
u Value
v = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> Value -> IO Value
forall (m :: * -> *) a r.
(MonadIO m, Postable a, FromJSON r) =>
Options -> FilePath -> a -> m r
jpostWith Options
opts FilePath
u Value
v
jpostAuthVal :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value
jpostAuthVal :: FilePath -> Value -> m Value
jpostAuthVal = FilePath -> Value -> m Value
forall (m :: * -> *) a r.
(HasGoProAuth m, MonadIO m, Postable a, FromJSON r) =>
FilePath -> a -> m r
jpostAuth
createMedium :: (HasGoProAuth m, MonadIO m) => Uploader m MediumID
createMedium :: Uploader m Text
createMedium = do
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let m1 :: Value
m1 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"file_extension" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
extension
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"filename" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String (FilePath -> Text
T.pack FilePath
filename)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"type" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ MediumType -> Value
forall a. ToJSON a => a -> Value
J.toJSON MediumType
mediumType
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"on_public_profile" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"content_title" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String (FilePath -> Text
T.pack FilePath
filename)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"content_source" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"web_media_library"
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Text
m <- Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> (Value -> Maybe Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Value -> Text) -> StateT (Env m) m Value -> Uploader m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Value -> StateT (Env m) m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal FilePath
"https://api.gopro.com/media" Value
m1
(Env m -> Env m) -> StateT (Env m) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
s -> Env m
s{mediumID :: Text
mediumID=Text
m})
Text -> Uploader m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
m
createSource :: (HasGoProAuth m, MonadIO m) => Int -> Uploader m DerivativeID
createSource :: Int -> Uploader m Text
createSource Int
nparts = Int -> Text -> Text -> Uploader m Text
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Text -> Text -> Uploader m Text
createDerivative Int
nparts Text
"Source" Text
"Source"
createDerivative :: (HasGoProAuth m, MonadIO m)
=> Int
-> T.Text
-> T.Text
-> Uploader m DerivativeID
createDerivative :: Int -> Text -> Text -> Uploader m Text
createDerivative Int
nparts Text
typ Text
lbl = do
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let d1 :: Value
d1 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"medium_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
mediumID
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"file_extension" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
extension
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"type" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
typ
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"label" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
lbl
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"available" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"item_count" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nparts)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"camera_positions" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"on_public_profile" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> (Value -> Maybe Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Value -> Text) -> StateT (Env m) m Value -> Uploader m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Value -> StateT (Env m) m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal FilePath
"https://api.gopro.com/derivatives" Value
d1
data UploadPart = UploadPart {
UploadPart -> Integer
_uploadLength :: Integer,
UploadPart -> Integer
_uploadPart :: Integer,
UploadPart -> FilePath
_uploadURL :: String
} deriving Int -> UploadPart -> FilePath -> FilePath
[UploadPart] -> FilePath -> FilePath
UploadPart -> FilePath
(Int -> UploadPart -> FilePath -> FilePath)
-> (UploadPart -> FilePath)
-> ([UploadPart] -> FilePath -> FilePath)
-> Show UploadPart
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [UploadPart] -> FilePath -> FilePath
$cshowList :: [UploadPart] -> FilePath -> FilePath
show :: UploadPart -> FilePath
$cshow :: UploadPart -> FilePath
showsPrec :: Int -> UploadPart -> FilePath -> FilePath
$cshowsPrec :: Int -> UploadPart -> FilePath -> FilePath
Show
makeLenses ''UploadPart
data Upload = Upload {
Upload -> Text
_uploadID :: UploadID,
Upload -> [UploadPart]
_uploadParts :: [UploadPart]
} deriving Int -> Upload -> FilePath -> FilePath
[Upload] -> FilePath -> FilePath
Upload -> FilePath
(Int -> Upload -> FilePath -> FilePath)
-> (Upload -> FilePath)
-> ([Upload] -> FilePath -> FilePath)
-> Show Upload
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Upload] -> FilePath -> FilePath
$cshowList :: [Upload] -> FilePath -> FilePath
show :: Upload -> FilePath
$cshow :: Upload -> FilePath
showsPrec :: Int -> Upload -> FilePath -> FilePath
$cshowsPrec :: Int -> Upload -> FilePath -> FilePath
Show
makeLenses ''Upload
chunkSize :: Integer
chunkSize :: Integer
chunkSize = Integer
6291456
createUpload :: (HasGoProAuth m, MonadIO m)
=> DerivativeID
-> Int
-> Int
-> Uploader m Upload
createUpload :: Text -> Int -> Int -> Uploader m Upload
createUpload Text
did Int
part Int
fsize = do
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let u1 :: Value
u1 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"derivative_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
did
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"camera_position" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"item_number" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Value
ur <- FilePath -> Value -> StateT (Env m) m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpost FilePath
"https://api.gopro.com/user-uploads" Value
u1
let Just Text
upid = Value
ur Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"id" ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
Text -> Text -> Int -> Int -> Uploader m Upload
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Text -> Int -> Int -> Uploader m Upload
getUpload Text
upid Text
did Int
part Int
fsize
where
popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]
jpost :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value
jpost :: FilePath -> Value -> m Value
jpost FilePath
u Value
p = (AuthInfo -> Text
_access_token (AuthInfo -> Text) -> m AuthInfo -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth) m Text -> (Text -> m Value) -> m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
tok -> Options -> FilePath -> Value -> m Value
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Options -> FilePath -> Value -> m Value
jpostVal (Text -> Options
popts Text
tok) FilePath
u Value
p
getUpload :: (HasGoProAuth m, MonadIO m)
=> UploadID
-> DerivativeID
-> Int
-> Int
-> Uploader m Upload
getUpload :: Text -> Text -> Int -> Int -> Uploader m Upload
getUpload Text
upid Text
did Int
part Int
fsize = do
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let pages :: Int
pages = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsize :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunkSize) :: Int
upopts :: Options
upopts = Text -> Options
authOpts Text
_access_token Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& ([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options
Lens' Options [(Text, Text)]
params (([(Text, Text)] -> Identity [(Text, Text)])
-> Options -> Identity Options)
-> [(Text, Text)] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Text
"id", Text
upid),
(Text
"page", Text
"1"),
(Text
"per_page", (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
pages),
(Text
"item_number", (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
part),
(Text
"camera_position", Text
"default"),
(Text
"file_size", (FilePath -> Text
T.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) Int
fsize),
(Text
"part_size", (FilePath -> Text
T.pack (FilePath -> Text) -> (Integer -> FilePath) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) Integer
chunkSize)]
Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]
Value
upaths <- Options -> FilePath -> StateT (Env m) m Value
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Options -> FilePath -> m a
jgetWith Options
upopts (Text -> FilePath
T.unpack (Text
"https://api.gopro.com/user-uploads/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
did))
let Just [Value]
ups = (Value
upaths :: J.Value) Value -> Getting (First [Value]) Value [Value] -> Maybe [Value]
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"_embedded" ((Value -> Const (First [Value]) Value)
-> Value -> Const (First [Value]) Value)
-> Getting (First [Value]) Value [Value]
-> Getting (First [Value]) Value [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"authorizations" ((Value -> Const (First [Value]) Value)
-> Value -> Const (First [Value]) Value)
-> Getting (First [Value]) Value [Value]
-> Getting (First [Value]) Value [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First [Value]) (Vector Value))
-> Value -> Const (First [Value]) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> Const (First [Value]) (Vector Value))
-> Value -> Const (First [Value]) Value)
-> (([Value] -> Const (First [Value]) [Value])
-> Vector Value -> Const (First [Value]) (Vector Value))
-> Getting (First [Value]) Value [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> [Value])
-> ([Value] -> Const (First [Value]) [Value])
-> Vector Value
-> Const (First [Value]) (Vector Value)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList
Upload -> Uploader m Upload
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Upload -> Uploader m Upload) -> Upload -> Uploader m Upload
forall a b. (a -> b) -> a -> b
$ Text -> [UploadPart] -> Upload
Upload Text
upid (Maybe [UploadPart] -> [UploadPart]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [UploadPart] -> [UploadPart])
-> Maybe [UploadPart] -> [UploadPart]
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe UploadPart) -> [Value] -> Maybe [UploadPart]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Maybe UploadPart
forall s. AsValue s => s -> Maybe UploadPart
aChunk [Value]
ups)
where
tInt :: T.Text -> Integer
tInt :: Text -> Integer
tInt = FilePath -> Integer
forall a. Read a => FilePath -> a
read (FilePath -> Integer) -> (Text -> FilePath) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
aChunk :: s -> Maybe UploadPart
aChunk s
v = (Integer -> Integer -> FilePath -> UploadPart)
-> Maybe Integer
-> Maybe Integer
-> Maybe FilePath
-> Maybe UploadPart
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Integer -> Integer -> FilePath -> UploadPart
UploadPart (s
v s -> Getting (First Integer) s Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"Content-Length" ((Value -> Const (First Integer) Value)
-> s -> Const (First Integer) s)
-> ((Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) s Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Integer) Text)
-> Value -> Const (First Integer) Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const (First Integer) Text)
-> Value -> Const (First Integer) Value)
-> ((Integer -> Const (First Integer) Integer)
-> Text -> Const (First Integer) Text)
-> (Integer -> Const (First Integer) Integer)
-> Value
-> Const (First Integer) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Integer)
-> (Integer -> Const (First Integer) Integer)
-> Text
-> Const (First Integer) Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Integer
tInt)
(s
v s -> Getting (First Integer) s Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"part" ((Value -> Const (First Integer) Value)
-> s -> Const (First Integer) s)
-> ((Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) s Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value
forall t. AsNumber t => Prism' t Integer
_Integer ((Integer -> Const (First Integer) Integer)
-> Value -> Const (First Integer) Value)
-> ((Integer -> Const (First Integer) Integer)
-> Integer -> Const (First Integer) Integer)
-> (Integer -> Const (First Integer) Integer)
-> Value
-> Const (First Integer) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer)
-> (Integer -> Const (First Integer) Integer)
-> Integer
-> Const (First Integer) Integer
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Integer -> Integer
forall a. Integral a => a -> Integer
toInteger)
(s
v s -> Getting (First FilePath) s FilePath -> Maybe FilePath
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"url" ((Value -> Const (First FilePath) Value)
-> s -> Const (First FilePath) s)
-> ((FilePath -> Const (First FilePath) FilePath)
-> Value -> Const (First FilePath) Value)
-> Getting (First FilePath) s FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First FilePath) Text)
-> Value -> Const (First FilePath) Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const (First FilePath) Text)
-> Value -> Const (First FilePath) Value)
-> ((FilePath -> Const (First FilePath) FilePath)
-> Text -> Const (First FilePath) Text)
-> (FilePath -> Const (First FilePath) FilePath)
-> Value
-> Const (First FilePath) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FilePath)
-> (FilePath -> Const (First FilePath) FilePath)
-> Text
-> Const (First FilePath) Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> FilePath
T.unpack)
uploadChunk :: (MonadMask m, MonadIO m)
=> FilePath
-> UploadPart
-> Uploader m ()
uploadChunk :: FilePath -> UploadPart -> Uploader m ()
uploadChunk FilePath
fp UploadPart{Integer
FilePath
_uploadURL :: FilePath
_uploadPart :: Integer
_uploadLength :: Integer
_uploadURL :: UploadPart -> FilePath
_uploadPart :: UploadPart -> Integer
_uploadLength :: UploadPart -> Integer
..} = RetryPolicyM (StateT (Env m) m)
-> (RetryStatus -> Uploader m ()) -> Uploader m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll RetryPolicyM (StateT (Env m) m)
policy ((RetryStatus -> Uploader m ()) -> Uploader m ())
-> (RetryStatus -> Uploader m ()) -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ \RetryStatus
r -> do
Bool -> Uploader m () -> Uploader m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RetryStatus -> Int
rsIterNumber RetryStatus
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Uploader m () -> Uploader m ()) -> Uploader m () -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ (Env m -> FilePath -> m ()) -> StateT (Env m) m (FilePath -> m ())
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env m -> FilePath -> m ()
forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
logAction StateT (Env m) m (FilePath -> m ())
-> ((FilePath -> m ()) -> Uploader m ()) -> Uploader m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath -> m ()
f -> m () -> Uploader m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> m ()
f (Int -> FilePath
forall a. Show a => a -> FilePath
retryMsg (RetryStatus -> Int
rsIterNumber RetryStatus
r)))
IO () -> Uploader m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Uploader m ()) -> IO () -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
fh -> do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
fh SeekMode
AbsoluteSeek ((Integer
_uploadPart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
chunkSize)
IO (Response ByteString) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Response ByteString) -> IO ())
-> IO (Response ByteString) -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> ByteString -> IO (Response ByteString)
forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith Options
defOpts FilePath
_uploadURL (ByteString -> IO (Response ByteString))
-> IO ByteString -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> Int -> IO ByteString
BL.hGet Handle
fh (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_uploadLength)
where policy :: RetryPolicyM (StateT (Env m) m)
policy = Int -> RetryPolicy
exponentialBackoff Int
2000000 RetryPolicyM (StateT (Env m) m)
-> RetryPolicyM (StateT (Env m) m)
-> RetryPolicyM (StateT (Env m) m)
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
9
retryMsg :: a -> FilePath
retryMsg a
a = [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"Retrying upload of ", FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fp,
FilePath
" part ", Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
_uploadPart, FilePath
" attempt ", a -> FilePath
forall a. Show a => a -> FilePath
show a
a]
completeUpload :: (HasGoProAuth m, MonadIO m)
=> UploadID
-> DerivativeID
-> Int
-> Integer
-> Uploader m ()
completeUpload :: Text -> Text -> Int -> Integer -> Uploader m ()
completeUpload Text
upid Text
did Int
part Integer
fsize = do
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let u2 :: Value
u2 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
upid
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"item_number" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"camera_position" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"complete" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
True
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"derivative_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
did
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"file_size" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String ((FilePath -> Text
T.pack (FilePath -> Text) -> (Integer -> FilePath) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) Integer
fsize)
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"part_size" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String ((FilePath -> Text
T.pack (FilePath -> Text) -> (Integer -> FilePath) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) Integer
chunkSize))
StateT (Env m) m (Response ByteString) -> Uploader m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT (Env m) m (Response ByteString) -> Uploader m ())
-> (IO (Response ByteString)
-> StateT (Env m) m (Response ByteString))
-> IO (Response ByteString)
-> Uploader m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ByteString) -> StateT (Env m) m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> Uploader m ())
-> IO (Response ByteString) -> Uploader m ()
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> Value -> IO (Response ByteString)
forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith (Text -> Options
popts Text
_access_token) (Text -> FilePath
T.unpack (Text
"https://api.gopro.com/user-uploads/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
did)) Value
u2
where
popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]
markAvailable :: (HasGoProAuth m, MonadIO m) => DerivativeID -> Uploader m ()
markAvailable :: Text -> Uploader m ()
markAvailable Text
did = do
Env{FilePath
[FilePath]
Text
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: [FilePath]
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
mediumID :: forall (m :: * -> *). Env m -> Text
filename :: forall (m :: * -> *). Env m -> FilePath
extension :: forall (m :: * -> *). Env m -> Text
mediumType :: forall (m :: * -> *). Env m -> MediumType
fileList :: forall (m :: * -> *). Env m -> [FilePath]
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
AuthInfo{Int
Text
_resource_owner_id :: Text
_refresh_token :: Text
_expires_in :: Int
_access_token :: Text
_resource_owner_id :: AuthInfo -> Text
_refresh_token :: AuthInfo -> Text
_expires_in :: AuthInfo -> Int
_access_token :: AuthInfo -> Text
..} <- StateT (Env m) m AuthInfo
forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let d2 :: Value
d2 = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"available" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
True
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Response ByteString
_ <- IO (Response ByteString) -> StateT (Env m) m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
-> StateT (Env m) m (Response ByteString))
-> IO (Response ByteString)
-> StateT (Env m) m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> FilePath -> Value -> IO (Response ByteString)
forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith (Text -> Options
popts Text
_access_token) (Text -> FilePath
T.unpack (Text
"https://api.gopro.com/derivatives/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
did)) Value
d2
UTCTime
now <- IO UTCTime -> StateT (Env m) m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let done :: Value
done = Object -> Value
J.Object (Object
forall a. Monoid a => a
mempty Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"upload_completed_at" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UTCTime -> Value
forall a. ToJSON a => a -> Value
J.toJSON UTCTime
now
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"client_updated_at" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ UTCTime -> Value
forall a. ToJSON a => a -> Value
J.toJSON UTCTime
now
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"revision_number" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number Scientific
0
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"access_token" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Object
"gopro_user_id" ((Maybe Value -> Identity (Maybe Value))
-> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Text -> Value -> Uploader m ()
forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m, Putable a) =>
Text -> a -> m ()
putMedium Text
mediumID Value
done
where
popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]
uploadMedium :: (HasGoProAuth m, MonadMask m, MonadFail m, MonadIO m)
=> [FilePath]
-> m MediumID
uploadMedium :: [FilePath] -> m Text
uploadMedium [] = FilePath -> m Text
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no files provided"
uploadMedium [FilePath]
fps = [FilePath] -> Uploader m Text -> m Text
forall (m :: * -> *) a.
(HasGoProAuth m, MonadFail m, MonadIO m) =>
[FilePath] -> Uploader m a -> m a
runUpload [FilePath]
fps (Uploader m Text -> m Text) -> Uploader m Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
Text
mid <- Uploader m Text
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Uploader m Text
createMedium
Text
did <- Int -> Uploader m Text
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Uploader m Text
createSource ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
fps)
((FilePath, Int) -> StateT (Env m) m ())
-> [(FilePath, Int)] -> StateT (Env m) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(FilePath
fp,Int
n) -> do
Integer
fsize <- FileOffset -> Integer
forall a. Integral a => a -> Integer
toInteger (FileOffset -> Integer)
-> (FileStatus -> FileOffset) -> FileStatus -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize (FileStatus -> Integer)
-> StateT (Env m) m FileStatus -> StateT (Env m) m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO FileStatus -> StateT (Env m) m FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> StateT (Env m) m FileStatus)
-> (FilePath -> IO FileStatus)
-> FilePath
-> StateT (Env m) m FileStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FileStatus
getFileStatus) FilePath
fp
Upload{[UploadPart]
Text
_uploadParts :: [UploadPart]
_uploadID :: Text
_uploadParts :: Upload -> [UploadPart]
_uploadID :: Upload -> Text
..} <- Text -> Int -> Int -> Uploader m Upload
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Int -> Int -> Uploader m Upload
createUpload Text
did Int
n (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
fsize)
(UploadPart -> StateT (Env m) m ())
-> [UploadPart] -> StateT (Env m) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> UploadPart -> StateT (Env m) m ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
FilePath -> UploadPart -> Uploader m ()
uploadChunk FilePath
fp) [UploadPart]
_uploadParts
Text -> Text -> Int -> Integer -> StateT (Env m) m ()
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Text -> Int -> Integer -> Uploader m ()
completeUpload Text
_uploadID Text
did Int
n Integer
fsize
) ([(FilePath, Int)] -> StateT (Env m) m ())
-> [(FilePath, Int)] -> StateT (Env m) m ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [Int] -> [(FilePath, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
fps [Int
1..]
Text -> StateT (Env m) m ()
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Uploader m ()
markAvailable Text
did
Text -> Uploader m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
mid