diff --git a/opentok.cabal b/opentok.cabal --- a/opentok.cabal +++ b/opentok.cabal @@ -1,5 +1,5 @@ name: opentok -version: 0.0.3 +version: 0.0.4 synopsis: An OpenTok SDK for Haskell description: . diff --git a/src/OpenTok.hs b/src/OpenTok.hs --- a/src/OpenTok.hs +++ b/src/OpenTok.hs @@ -10,6 +10,8 @@ , tokenOpts , startArchive , stopArchive + , listArchives + , deleteArchive ) where @@ -76,3 +78,17 @@ -- stopArchive :: OpenTok -> ArchiveId -> IO (Either OTError Archive) stopArchive ot = OpenTok.Archive.stop (client ot) + +-- | Get a list of all archives for a project or a single session +-- +-- > listArchives ot listArchiveOpts { _forSessionId = "some_session_id" } +-- +listArchives :: OpenTok -> ListArchiveOptions -> IO (Either OTError ArchiveCollection) +listArchives ot = OpenTok.Archive.list (client ot) + +-- | Delete an Archive +-- +-- > deleteArchive ot "some_archive_id" +-- +deleteArchive :: OpenTok -> ArchiveId -> IO (Either OTError ArchiveId) +deleteArchive ot = OpenTok.Archive.delete (client ot) diff --git a/src/OpenTok/Archive.hs b/src/OpenTok/Archive.hs --- a/src/OpenTok/Archive.hs +++ b/src/OpenTok/Archive.hs @@ -34,8 +34,20 @@ , duration , sessionId ) + , ListArchiveOptions + ( _forSessionId + , _count + , _offset + ) + , listArchiveOpts + , ArchiveCollection + ( count + , items + ) , start , stop + , list + , delete ) where @@ -150,9 +162,9 @@ @ Archive { id :: 'String', - status :: 'String', + status :: 'ArchiveStatus', createdAt :: 'Integer', - size :: 'Float', + size :: 'Int', partnerId :: 'Int', url :: Maybe 'String', resolution :: 'ArchiveResolution', @@ -162,7 +174,7 @@ reason :: 'String', name :: 'String', updatedAt :: 'Integer', - duration :: 'Float', + duration :: 'Int', sessionId :: 'String' } @ @@ -170,9 +182,9 @@ -} data Archive = Archive { id :: String, - status :: String, + status :: ArchiveStatus, createdAt :: Integer, - size :: Float, + size :: Int, partnerId :: Int, url :: Maybe String, resolution :: ArchiveResolution, @@ -180,9 +192,9 @@ hasAudio :: Bool, hasVideo :: Bool, reason :: String, - name :: String, + name :: Maybe String, updatedAt :: Integer, - duration :: Float, + duration :: Int, sessionId :: String } deriving (Show, Generic) @@ -206,3 +218,83 @@ case response of Right archive -> pure $ Right archive Left e -> pure $ Left $ "An error occurred in attempting to stop an archive: " <> message e + + +{-| + +Options for listing archives + +@ +ListArchiveOptions { + _forSessionId :: `Maybe` `SessionId`, + _count :: `Int`, + _offset :: `Int` +} +@ + +-} +data ListArchiveOptions = ListArchiveOptions { + _forSessionId :: Maybe SessionId, + _offset :: Int, + _count :: Int +} + +{-| +Default List Archive options + +@ +ListArchiveOptions + { _forSessionId = `Nothing` + , _offset = 0 + , _count = 50 +} +@ + +-} +listArchiveOpts :: ListArchiveOptions +listArchiveOpts = ListArchiveOptions { + _forSessionId = Nothing, + _offset = 0, + _count = 50 +} + +{-| + +An OpenTok Archive Collection + +@ +ArchiveCollection { + count :: 'Int' + items :: ['Archive'] + id :: 'String' +} +@ + +-} +data ArchiveCollection = ArchiveCollection { + count :: Int, + items :: [Archive] +} deriving (Generic, Show) + +instance FromJSON ArchiveCollection + +list :: Client -> ListArchiveOptions -> IO (Either OTError ArchiveCollection) +list c opts = do + let sessionQuery = maybe "" (\sid -> "sessionId=" <> sid <> "&") (_forSessionId opts) + let pagingQuery = "offset=" <> (show $ _offset opts) <> "&count=" <>( show $ _count opts) + let query = "?" <> sessionQuery <> pagingQuery + let path = "/v2/project/" <> _apiKey c <> "/archive" <> query + response <- get c path :: IO (Either ClientError ArchiveCollection) + case response of + Right archive -> pure $ Right archive + Left e -> pure $ Left $ "An error occurred in retrieving an archive list: " <> message e + +delete :: Client -> ArchiveId -> IO (Either OTError ArchiveId) +delete c aid = do + let path = "/v2/project/" <> _apiKey c <> "/archive/" <> aid + response <- del c path :: IO (Either ClientError String) + case response of + Right _ -> pure $ Right $ "Successfully deleted archive " <> aid + Left e -> case statusCode e of + 409 -> pure $ Left "Archive has status other than uploaded, available or deleted." + _ -> pure $ Left $ message e diff --git a/src/OpenTok/Client.hs b/src/OpenTok/Client.hs --- a/src/OpenTok/Client.hs +++ b/src/OpenTok/Client.hs @@ -7,9 +7,10 @@ ( Client(Client, _apiKey, _secret) , ClientError(statusCode, message) , Path - , emptyOptions , post , postWithBody + , get + , del ) where @@ -18,7 +19,6 @@ import Control.Arrow ( left ) import Control.Lens.Combinators import Control.Lens.Operators --- import Control.Monad.Trans.Either ( eitherT ) import Control.Monad.Time import Control.Monad.Trans.Except import Crypto.JWT @@ -97,13 +97,6 @@ signJWT key claims = runExceptT $ signClaims key (newJWSHeader ((), HS256)) claims -data EmptyOptions = EmptyOptions deriving (Generic) -instance ToJSON EmptyOptions - --- | A dummy type used when not passing any options to request -emptyOptions :: Maybe EmptyOptions -emptyOptions = Nothing - createJWT :: Client -> IO (Either ClientError SignedJWT) createJWT client = do claims <- mkClaims (_apiKey client) @@ -124,7 +117,6 @@ buildV1Headers :: SignedJWT -> RequestHeaders buildV1Headers jwt = drop 1 $ buildHeaders jwt - -- | Execute an API request execute :: (FromJSON a) => Request -> IO (Either ClientError a) execute req = do @@ -133,11 +125,21 @@ let body = responseBody response let sc = getResponseStatusCode response case sc of - 200 -> pure $ left (\_ -> decodeError sc) (eitherDecode body) + 200 -> pure $ left (\m -> (decodeError sc) { message = m }) (eitherDecode body) _ -> pure $ Left $ maybe (decodeError sc) (ClientError sc . _message) (decode body :: Maybe APIError) +-- | Execute an API request to delete a resource +deleteResource :: Request -> IO (Either ClientError String) +deleteResource req = do + manager <- newManager tlsManagerSettings + response <- httpLbs req manager + let sc = getResponseStatusCode response + case sc of + 204 -> pure $ Right "Ok" + _ -> pure $ Left $ ClientError sc "Failed to delete resource" + buildRequest :: Path -> SignedJWT -> IO Request buildRequest p jwt = do initialRequest <- parseRequest $ "https://api.opentok.com" <> p @@ -164,3 +166,22 @@ request <- buildRequest p jwt execute $ request { requestBody = RequestBodyLBS $ encode b } +-- | Make a GET request with a body +get :: (FromJSON a) => Client -> Path -> IO (Either ClientError a) +get client p = do + eitherJWT <- createJWT client + case eitherJWT of + Left e -> pure $ Left $ e + Right jwt -> do + request <- buildRequest p jwt + execute $ request { method = "GET" } + +-- | Make a GET request with a body +del :: Client -> Path -> IO (Either ClientError String) +del client p = do + eitherJWT <- createJWT client + case eitherJWT of + Left e -> pure $ Left $ e + Right jwt -> do + request <- buildRequest p jwt + deleteResource $ request { method = "DELETE" }