module Effectful.Globus
  ( Globus (..)
  , GlobusClient (..)
  , runGlobus
  , State (..)
  , Req.Scheme (..)
  , Tagged (..)
  , module Network.Globus.Types
  , TransferRequest (..)
  , TransferResponse (..)
  , TransferItem (..)
  , SyncLevel (..)
  , Task (..)
  , TaskStatus (..)
  , TaskFilters (..)
  , TaskList (..)
  ) where

import Data.List.NonEmpty (NonEmpty)
import Data.Tagged
import Effectful
import Effectful.Dispatch.Dynamic
import Network.Globus.Auth
import Network.Globus.Transfer
import Network.Globus.Types
import Network.HTTP.Req as Req


data GlobusClient = GlobusClient
  { GlobusClient -> Token 'ClientId
clientId :: Token ClientId
  , GlobusClient -> Token 'ClientSecret
clientSecret :: Token ClientSecret
  }


data Globus :: Effect where
  AuthUrl :: Uri Redirect -> NonEmpty Scope -> State -> Globus m (Uri Authorization)
  GetUserInfo :: Token OpenId -> Globus m UserInfoResponse
  GetAccessTokens :: Token Exchange -> Uri Redirect -> Globus m (NonEmpty TokenItem)
  SubmissionId :: Token Access -> Globus m (Id Submission)
  Transfer :: Token Access -> TransferRequest -> Globus m TransferResponse
  StatusTask :: Token Access -> Id Task -> Globus m Task
  StatusTasks :: Token Access -> TaskFilters -> Globus m TaskList


type instance DispatchOf Globus = 'Dynamic


runGlobus
  :: (IOE :> es)
  => GlobusClient
  -> Eff (Globus : es) a
  -> Eff es a
runGlobus :: forall (es :: [Effect]) a.
(IOE :> es) =>
GlobusClient -> Eff (Globus : es) a -> Eff es a
runGlobus GlobusClient
g = EffectHandler Globus es -> Eff (Globus : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler Globus es -> Eff (Globus : es) a -> Eff es a)
-> EffectHandler Globus es -> Eff (Globus : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
_ -> \case
  GetAccessTokens Token 'Exchange
exc Uri 'Redirect
red -> do
    IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Token 'ClientId
-> Token 'ClientSecret
-> Uri 'Redirect
-> Token 'Exchange
-> IO (NonEmpty TokenItem)
forall (m :: * -> *).
MonadIO m =>
Token 'ClientId
-> Token 'ClientSecret
-> Uri 'Redirect
-> Token 'Exchange
-> m (NonEmpty TokenItem)
fetchAccessTokens GlobusClient
g.clientId GlobusClient
g.clientSecret Uri 'Redirect
red Token 'Exchange
exc
  GetUserInfo Token 'OpenId
ti -> do
    IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Token 'OpenId -> IO UserInfoResponse
forall (m :: * -> *).
MonadIO m =>
Token 'OpenId -> m UserInfoResponse
fetchUserInfo Token 'OpenId
ti
  AuthUrl Uri 'Redirect
red NonEmpty Scope
scopes State
state -> do
    Uri 'Authorization -> Eff es (Uri 'Authorization)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Uri 'Authorization -> Eff es (Uri 'Authorization))
-> Uri 'Authorization -> Eff es (Uri 'Authorization)
forall a b. (a -> b) -> a -> b
$ Token 'ClientId
-> Uri 'Redirect -> NonEmpty Scope -> State -> Uri 'Authorization
authorizationUrl GlobusClient
g.clientId Uri 'Redirect
red NonEmpty Scope
scopes State
state
  SubmissionId Token 'Access
access -> do
    IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Token 'Access -> IO (Tagged 'Submission Text)
forall (m :: * -> *).
MonadIO m =>
Token 'Access -> m (Tagged 'Submission Text)
fetchSubmissionId Token 'Access
access
  Transfer Token 'Access
access TransferRequest
request -> do
    IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Token 'Access -> TransferRequest -> IO TransferResponse
forall (m :: * -> *).
MonadIO m =>
Token 'Access -> TransferRequest -> m TransferResponse
sendTransfer Token 'Access
access TransferRequest
request
  StatusTask Token 'Access
access Id Task
ti -> do
    IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Token 'Access -> Id Task -> IO Task
forall (m :: * -> *).
MonadIO m =>
Token 'Access -> Id Task -> m Task
fetchTask Token 'Access
access Id Task
ti
  StatusTasks Token 'Access
access TaskFilters
tf -> do
    IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Token 'Access -> TaskFilters -> IO TaskList
forall (m :: * -> *).
MonadIO m =>
Token 'Access -> TaskFilters -> m TaskList
fetchTasks Token 'Access
access TaskFilters
tf