{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module OpenTok.Archive
( OutputMode(..)
, ArchiveResolution(..)
, ArchiveOptions(..)
, archiveOpts
, ArchiveStatus(..)
, Archive(..)
, ListArchiveOptions(..)
, listArchiveOpts
, ArchiveCollection(..)
, start
, stop
, list
, delete
)
where
import Prelude ( )
import Prelude.Compat
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH
import Data.Data
import Data.Semigroup ( (<>) )
import Data.Strings ( strToLower )
import GHC.Generics
import OpenTok.Client
import OpenTok.Types
data OutputMode = Composed | Individual deriving (Data, Generic, Typeable)
instance Show OutputMode where
show = strToLower . showConstr . toConstr
deriveJSON defaultOptions { constructorTagModifier = strToLower } ''OutputMode
data ArchiveResolution = SD | HD
instance Show ArchiveResolution where
show SD = "640x480 (SD)"
show HD = "1280x720 (HD)"
instance ToJSON ArchiveResolution where
toJSON SD = String "640x480"
toJSON HD = String "1280x720"
instance FromJSON ArchiveResolution where
parseJSON (String s) = case s of
"640x480" -> pure SD
"1280x720" -> pure HD
_ -> typeMismatch "Could not parse ArchiveResolution" (String s)
parseJSON x = typeMismatch "Expected String" x
data ArchiveOptions = ArchiveOptions {
_hasAudio :: Bool,
_hasVideo :: Bool,
_name :: Maybe String,
_outputMode :: OutputMode,
_resolution :: ArchiveResolution,
_sessionId :: SessionId
} deriving (Generic, Show)
instance ToJSON ArchiveOptions where
toJSON = genericToJSON defaultOptions { omitNothingFields = True, fieldLabelModifier = drop 1 }
archiveOpts :: ArchiveOptions
archiveOpts = ArchiveOptions
{ _hasAudio = True
, _hasVideo = True
, _name = Nothing
, _outputMode = Composed
, _resolution = SD
, _sessionId = ""
}
data ArchiveStatus = Available | Expired | Failed | Paused | Started | Stopped | Uploaded deriving (Data, Generic, Typeable)
deriveJSON defaultOptions { constructorTagModifier = strToLower } ''ArchiveStatus
instance Show ArchiveStatus where
show = strToLower . showConstr . toConstr
data Archive = Archive {
id :: String,
status :: ArchiveStatus,
createdAt :: Integer,
size :: Int,
partnerId :: Int,
url :: Maybe String,
resolution :: ArchiveResolution,
outputMode :: OutputMode,
hasAudio :: Bool,
hasVideo :: Bool,
reason :: String,
name :: Maybe String,
updatedAt :: Integer,
duration :: Int,
sessionId :: String
} deriving (Show, Generic)
instance FromJSON Archive where
parseJSON = genericParseJSON defaultOptions
start :: Client -> ArchiveOptions -> IO (Either OTError Archive)
start c opts = do
let path = "/v2/project/" <> _apiKey c <> "/archive"
response <- postWithBody c path (Just opts) :: IO (Either ClientError Archive)
case response of
Right archive -> pure $ Right archive
Left e -> pure $ Left $ "Failed to start archive: " <> message e
stop :: Client -> ArchiveId -> IO (Either OTError Archive)
stop c aId = do
let path = "/v2/project/" <> _apiKey c <> "/archive/" <> aId <> "/stop"
response <- post c path :: IO (Either ClientError Archive)
case response of
Right archive -> pure $ Right archive
Left e -> pure $ Left $ "An error occurred in attempting to stop an archive: " <> message e
data ListArchiveOptions = ListArchiveOptions {
_forSessionId :: Maybe SessionId,
_offset :: Int,
_count :: Int
}
listArchiveOpts :: ListArchiveOptions
listArchiveOpts = ListArchiveOptions {
_forSessionId = Nothing,
_offset = 0,
_count = 50
}
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