{-# 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, setChunkSize,
listUploading
) where
import Control.Applicative (liftA3)
import Control.Lens
import Control.Monad (void, when, zipWithM_)
import Control.Monad.Catch (MonadMask (..))
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.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Data.Char (toUpper)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromJust, fromMaybe)
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 System.FilePath.Posix (takeExtension, takeFileName)
import System.IO (IOMode (..), SeekMode (..), hSeek, withFile)
import System.Posix.Files (fileSize, getFileStatus)
import Text.Read (readMaybe)
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 -> NonEmpty FilePath
fileList :: NonEmpty FilePath,
Env m -> MediumType
mediumType :: MediumType,
Env m -> Text
extension :: T.Text,
Env m -> FilePath
filename :: String,
Env m -> Text
mediumID :: MediumID,
Env m -> Integer
chunkSize :: Integer,
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
UTCTime
Text
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, MonadIO m)
=> NonEmpty FilePath
-> Uploader m a
-> m a
runUpload :: NonEmpty FilePath -> Uploader m a -> m a
runUpload NonEmpty FilePath
fileList = NonEmpty FilePath -> Text -> Uploader m a -> m a
forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Text -> Uploader m a -> m a
resumeUpload NonEmpty FilePath
fileList Text
""
defaultChunkSize :: Integer
defaultChunkSize :: Integer
defaultChunkSize = Integer
6Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1024Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1024
resumeUpload :: (HasGoProAuth m, MonadIO m) => NonEmpty FilePath -> MediumID -> Uploader m a -> m a
resumeUpload :: NonEmpty FilePath -> Text -> Uploader m a -> m a
resumeUpload fileList :: NonEmpty FilePath
fileList@(FilePath
fp :| [FilePath]
_) Text
mediumID Uploader m a
a = 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 :: * -> *).
NonEmpty FilePath
-> MediumType
-> Text
-> FilePath
-> Text
-> Integer
-> ((MonadMask m, Monad m) => FilePath -> m ())
-> Env m
Env{Integer
FilePath
Text
NonEmpty FilePath
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
forall (f :: * -> *) p. Applicative f => p -> f ()
chunkSize :: Integer
logAction :: forall (f :: * -> *) p. Applicative f => p -> f ()
mediumType :: MediumType
filename :: FilePath
extension :: Text
mediumID :: Text
fileList :: NonEmpty FilePath
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty 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 ()
chunkSize :: Integer
chunkSize = Integer
defaultChunkSize
fileType :: a -> MediumType
fileType a
"JPG" = MediumType
Photo
fileType a
"GPR" = 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})
setChunkSize :: (Monad m, MonadMask m) => Integer -> Uploader m ()
setChunkSize :: Integer -> Uploader m ()
setChunkSize Integer
t = (Env m -> Env m) -> Uploader m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env m
m -> Env m
m{chunkSize :: Integer
chunkSize=Integer
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{Integer
FilePath
Text
NonEmpty FilePath
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: forall (m :: * -> *). Env m -> Integer
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 -> NonEmpty FilePath
..} <- StateT (Env m) m (Env m)
forall s (m :: * -> *). MonadState s m => m s
get
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
..} <- 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{Integer
FilePath
Text
NonEmpty FilePath
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: forall (m :: * -> *). Env m -> Integer
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 -> NonEmpty 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
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
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
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
Integer
csize <- (Env m -> Integer) -> StateT (Env m) m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env m -> Integer
forall (m :: * -> *). Env m -> Integer
chunkSize
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
csize) :: 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
csize)]
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 = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer)
-> (Text -> Maybe Integer) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe Integer
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe Integer)
-> (Text -> FilePath) -> Text -> Maybe 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)))
Integer
csize <- (Env m -> Integer) -> StateT (Env m) m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env m -> Integer
forall (m :: * -> *). Env m -> Integer
chunkSize
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
csize)
ByteString
bytes <- Handle -> Int -> IO ByteString
BL.hGet Handle
fh (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_uploadLength)
let opts :: Options
opts = Options
defOpts Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Content-Length" (([ByteString] -> Identity [ByteString])
-> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath -> ByteString
BC.pack (FilePath -> ByteString)
-> (ByteString -> FilePath) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> FilePath
forall a. Show a => a -> FilePath
show (Int64 -> FilePath)
-> (ByteString -> Int64) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bytes]
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
opts FilePath
_uploadURL ByteString
bytes
where policy :: RetryPolicyM (StateT (Env m) m)
policy = Int -> RetryPolicyM (StateT (Env m) m)
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
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
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
Integer
csize <- (Env m -> Integer) -> StateT (Env m) m Integer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env m -> Integer
forall (m :: * -> *). Env m -> Integer
chunkSize
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
csize))
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{Integer
FilePath
Text
NonEmpty FilePath
MediumType
(MonadMask m, Monad m) => FilePath -> m ()
logAction :: (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
logAction :: forall (m :: * -> *).
Env m -> (MonadMask m, Monad m) => FilePath -> m ()
chunkSize :: forall (m :: * -> *). Env m -> Integer
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 -> NonEmpty 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, MonadIO m)
=> NonEmpty FilePath
-> m MediumID
uploadMedium :: NonEmpty FilePath -> m Text
uploadMedium NonEmpty FilePath
fps = NonEmpty FilePath -> Uploader m Text -> m Text
forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Uploader m a -> m a
runUpload NonEmpty 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 (NonEmpty FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty FilePath
fps)
(FilePath -> Int -> StateT (Env m) m ())
-> [FilePath] -> [Int] -> StateT (Env m) m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\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
) (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty 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