{-# 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, 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 Control.Monad.Logger (MonadLogger (..), logInfoN)
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 = StateT Env
instance MonadUnliftIO m => MonadUnliftIO (StateT Env m) where
withRunInIO :: forall b.
((forall a. StateT Env m a -> IO a) -> IO b) -> StateT Env m b
withRunInIO (forall a. StateT Env m a -> IO a) -> IO b
inner =
forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env
st -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \Env
_ ->
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> (,Env
st) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. StateT Env m a -> IO a) -> IO b
inner (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Env
st)
instance HasGoProAuth m => HasGoProAuth (Uploader m) where
goproAuth :: Uploader m AuthInfo
goproAuth = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
data Env = Env {
Env -> NonEmpty FilePath
fileList :: NonEmpty FilePath,
Env -> MediumType
mediumType :: MediumType,
Env -> Text
extension :: T.Text,
Env -> FilePath
filename :: String,
Env -> Text
mediumID :: MediumID,
Env -> Integer
chunkSize :: Integer
}
listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium]
listUploading :: forall (m :: * -> *). (HasGoProAuth m, MonadIO m) => m [Medium]
listUploading = forall a. (a -> Bool) -> [a] -> [a]
filter (\Medium{Int
FilePath
Maybe Int
Maybe FilePath
UTCTime
Text
ReadyToViewType
MediumType
_medium_filename :: Medium -> Maybe FilePath
_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_filename :: Maybe FilePath
_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 forall a. Eq a => a -> a -> Bool
== ReadyToViewType
ViewUploading) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Uploader m a -> m a
runUpload NonEmpty FilePath
fileList = 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
6forall a. Num a => a -> a -> a
*Integer
1024forall a. Num a => a -> a -> a
*Integer
1024
resumeUpload :: (HasGoProAuth m, MonadIO m) => NonEmpty FilePath -> MediumID -> Uploader m a -> m a
resumeUpload :: forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Text -> Uploader m a -> m a
resumeUpload fileList :: NonEmpty FilePath
fileList@(FilePath
fp :| [FilePath]
_) Text
mediumID Uploader m a
a = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Uploader m a
a Env{Integer
FilePath
NonEmpty FilePath
Text
MediumType
chunkSize :: Integer
mediumType :: MediumType
filename :: FilePath
extension :: Text
mediumID :: Text
fileList :: NonEmpty FilePath
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
..}
where
extension :: Text
extension = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension forall a b. (a -> b) -> a -> b
$ FilePath
filename
filename :: FilePath
filename = FilePath -> FilePath
takeFileName FilePath
fp
mediumType :: MediumType
mediumType = forall {a}. (Eq a, IsString a) => a -> MediumType
fileType Text
extension
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 :: forall (m :: * -> *). Monad m => MediumType -> Uploader m ()
setMediumType MediumType
t = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
m -> Env
m{mediumType :: MediumType
mediumType=MediumType
t})
setChunkSize :: (Monad m, MonadMask m) => Integer -> Uploader m ()
setChunkSize :: forall (m :: * -> *).
(Monad m, MonadMask m) =>
Integer -> Uploader m ()
setChunkSize Integer
t = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
m -> Env
m{chunkSize :: Integer
chunkSize=Integer
t})
jpostVal :: (HasGoProAuth m, MonadIO m) => Options -> String -> J.Value -> m J.Value
jpostVal :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Options -> FilePath -> Value -> m Value
jpostVal Options
opts FilePath
u Value
v = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal = 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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Uploader m Text
createMedium = do
Env{Integer
FilePath
NonEmpty FilePath
Text
MediumType
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
chunkSize :: Env -> Integer
mediumID :: Env -> Text
filename :: Env -> FilePath
extension :: Env -> Text
mediumType :: Env -> MediumType
fileList :: Env -> NonEmpty FilePath
..} <- 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
..} <- forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let m1 :: Value
m1 = Object -> Value
J.Object (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"file_extension" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
extension
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"filename" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String (FilePath -> Text
T.pack FilePath
filename)
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"type" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
J.toJSON MediumType
mediumType
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"on_public_profile" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"content_title" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String (FilePath -> Text
T.pack FilePath
filename)
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"content_source" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"gda"
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"access_token" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"gopro_user_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Text
m <- forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall t. AsValue t => Key -> Traversal' t Value
key Key
"id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpostAuthVal FilePath
"https://api.gopro.com/media" Value
m1
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
s -> Env
s{mediumID :: Text
mediumID=Text
m})
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
m
createSource :: (HasGoProAuth m, MonadIO m) => Int -> Uploader m DerivativeID
createSource :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Uploader m Text
createSource Int
nparts = 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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Text -> Text -> Uploader m Text
createDerivative Int
nparts Text
typ Text
lbl = do
Env{Integer
FilePath
NonEmpty FilePath
Text
MediumType
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
chunkSize :: Env -> Integer
mediumID :: Env -> Text
filename :: Env -> FilePath
extension :: Env -> Text
mediumType :: Env -> MediumType
fileList :: Env -> NonEmpty FilePath
..} <- 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
..} <- forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let d1 :: Value
d1 = Object -> Value
J.Object (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"medium_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
mediumID
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"file_extension" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
extension
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"type" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
typ
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"label" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
lbl
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"available" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"item_count" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nparts)
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"camera_positions" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"on_public_profile" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
False
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"access_token" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"gopro_user_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall t. AsValue t => Key -> Traversal' t Value
key Key
"id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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
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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
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
..} <- forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let u1 :: Value
u1 = Object -> Value
J.Object (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"derivative_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
did
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"camera_position" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"item_number" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part)
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"access_token" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"gopro_user_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Value
ur <- 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 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"id" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
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 forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" 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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
FilePath -> Value -> m Value
jpost FilePath
u Value
p = (AuthInfo -> Text
_access_token forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
tok -> 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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
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
..} <- forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
Integer
csize <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Integer
chunkSize
let pages :: Int
pages = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fsize :: Double) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
csize) :: Int
upopts :: Options
upopts = Text -> Options
authOpts Text
_access_token forall a b. a -> (a -> b) -> b
& Lens' Options [(Text, Text)]
params 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Int
pages),
(Text
"item_number", (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Int
part),
(Text
"camera_position", Text
"default"),
(Text
"file_size", (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Int
fsize),
(Text
"part_size", (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Integer
csize)]
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" 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 <- 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/" forall a. Semigroup a => a -> a -> a
<> Text
did))
let Just [Value]
ups = (Value
upaths :: J.Value) forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"_embedded" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"authorizations" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. Vector a -> [a]
V.toList
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [UploadPart] -> Upload
Upload Text
upid (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {s}. AsValue s => s -> Maybe UploadPart
aChunk [Value]
ups)
where
tInt :: T.Text -> Integer
tInt :: Text -> Integer
tInt = forall a. a -> Maybe a -> a
fromMaybe Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => FilePath -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
aChunk :: s -> Maybe UploadPart
aChunk s
v = 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 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"Content-Length" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Integer
tInt)
(s
v forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"part" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Prism' t Integer
_Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. Integral a => a -> Integer
toInteger)
(s
v forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"url" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, MonadLogger m)
=> FilePath
-> UploadPart
-> Uploader m ()
uploadChunk :: forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadLogger m) =>
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
..} = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll RetryPolicyM (StateT Env m)
policy forall a b. (a -> b) -> a -> b
$ \RetryStatus
r -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RetryStatus -> Int
rsIterNumber RetryStatus
r forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoN (forall {a}. Show a => a -> Text
retryMsg (RetryStatus -> Int
rsIterNumber RetryStatus
r)))
Integer
csize <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Integer
chunkSize
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
fh -> do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
fh SeekMode
AbsoluteSeek ((Integer
_uploadPart forall a. Num a => a -> a -> a
- Integer
1) forall a. Num a => a -> a -> a
* Integer
csize)
ByteString
bytes <- Handle -> Int -> IO ByteString
BL.hGet Handle
fh (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
_uploadLength)
let opts :: Options
opts = Options
defOpts forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Content-Length" forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath -> ByteString
BC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length forall a b. (a -> b) -> a -> b
$ ByteString
bytes]
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
Putable a =>
Options -> FilePath -> a -> IO (Response ByteString)
putWith Options
opts FilePath
_uploadURL ByteString
bytes
where policy :: RetryPolicyM (StateT Env m)
policy = forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
exponentialBackoff Int
2000000 forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
9
retryMsg :: a -> Text
retryMsg a
a = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [FilePath
"Retrying upload of ", forall a. Show a => a -> FilePath
show FilePath
fp,
FilePath
" part ", forall a. Show a => a -> FilePath
show Integer
_uploadPart, FilePath
" attempt ", forall a. Show a => a -> FilePath
show a
a]
completeUpload :: (HasGoProAuth m, MonadIO m)
=> UploadID
-> DerivativeID
-> Int
-> Integer
-> Uploader m ()
completeUpload :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
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
..} <- forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
Integer
csize <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> Integer
chunkSize
let u2 :: Value
u2 = Object -> Value
J.Object (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
upid
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"item_number" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part)
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"camera_position" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
"default"
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"complete" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
True
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"derivative_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
did
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"file_size" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String ((FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Integer
fsize)
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"part_size" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String ((FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) Integer
csize))
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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/" forall a. Semigroup a => a -> a -> a
<> Text
did)) Value
u2
where
popts :: Text -> Options
popts Text
tok = Text -> Options
authOpts Text
tok forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" 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 :: forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Uploader m ()
markAvailable Text
did = do
Env{Integer
FilePath
NonEmpty FilePath
Text
MediumType
chunkSize :: Integer
mediumID :: Text
filename :: FilePath
extension :: Text
mediumType :: MediumType
fileList :: NonEmpty FilePath
chunkSize :: Env -> Integer
mediumID :: Env -> Text
filename :: Env -> FilePath
extension :: Env -> Text
mediumType :: Env -> MediumType
fileList :: Env -> NonEmpty FilePath
..} <- 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
..} <- forall (m :: * -> *). HasGoProAuth m => m AuthInfo
goproAuth
let d2 :: Value
d2 = Object -> Value
J.Object (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"available" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
J.Bool Bool
True
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"access_token" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"gopro_user_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
Response ByteString
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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/" forall a. Semigroup a => a -> a -> a
<> Text
did)) Value
d2
UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let done :: Value
done = Object -> Value
J.Object (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"upload_completed_at" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
J.toJSON UTCTime
now
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"client_updated_at" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
J.toJSON UTCTime
now
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"revision_number" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Scientific -> Value
J.Number Scientific
0
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"access_token" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_access_token
forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
"gopro_user_id" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
J.String Text
_resource_owner_id)
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 forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header HeaderName
"Accept" 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, MonadLogger m)
=> NonEmpty FilePath
-> m MediumID
uploadMedium :: forall (m :: * -> *).
(HasGoProAuth m, MonadMask m, MonadIO m, MonadLogger m) =>
NonEmpty FilePath -> m Text
uploadMedium NonEmpty FilePath
fps = forall (m :: * -> *) a.
(HasGoProAuth m, MonadIO m) =>
NonEmpty FilePath -> Uploader m a -> m a
runUpload NonEmpty FilePath
fps forall a b. (a -> b) -> a -> b
$ do
Text
mid <- forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Uploader m Text
createMedium
Text
did <- forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Int -> Uploader m Text
createSource (forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty FilePath
fps)
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (\FilePath
fp Int
n -> do
Integer
fsize <- forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileOffset
fileSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
..} <- forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Int -> Int -> Uploader m Upload
createUpload Text
did Int
n (forall a. Num a => Integer -> a
fromInteger Integer
fsize)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *).
(MonadMask m, MonadIO m, MonadLogger m) =>
FilePath -> UploadPart -> Uploader m ()
uploadChunk FilePath
fp) [UploadPart]
_uploadParts
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Text -> Int -> Integer -> Uploader m ()
completeUpload Text
_uploadID Text
did Int
n Integer
fsize
) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
fps) [Int
1..]
forall (m :: * -> *).
(HasGoProAuth m, MonadIO m) =>
Text -> Uploader m ()
markAvailable Text
did
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
mid