Archive.hs

{-# 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

-- | Composed means that streams will be composed into a single file
--
-- Individual means that an individual file will be created for each stream
--
data OutputMode = Composed | Individual deriving (Data, Generic, Typeable)

instance Show OutputMode where
  show = strToLower . showConstr . toConstr

deriveJSON defaultOptions { constructorTagModifier = strToLower } ''OutputMode

-- | SD (Standard Definition 640 x 480)
--
-- HD (High Definition 1280 x 720)
--
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

-- | Defines options for an Archive
--
-- sessionId: The session to be archived
--
-- hasAudio: Whether the archive will record audio
--
-- hasVideo: Whether the archive will record video
--
-- name: The name of the archive
--
-- Whether all streams in the archive are recorded to a
-- single file ('Composed') or to individual files ('Individual')
--
-- The resolution of the archive, either 'SD' (the default, 640 x 480),
-- or 'HD' (1280 x 720)
--
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 }

{-|
Default Archive options

@
ArchiveOptions
  { _hasVideo   = 'True'
  , _hasVideo   = 'True'
  , _name       = 'Nothing'
  , _outputMode = 'Composed'
  , _resolution = 'SD'
  , _sessionId  = ""
}
@

-}
archiveOpts :: ArchiveOptions
archiveOpts = ArchiveOptions
  { _hasAudio   = True
  , _hasVideo   = True
  , _name       = Nothing
  , _outputMode = Composed
  , _resolution = SD
  , _sessionId  = ""
  }

-- | Status of an OpenTok `Archive`
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

{-|

An OpenTok 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 :: 'String',
  updatedAt :: 'Integer',
  duration :: 'Int',
  sessionId :: 'String'
}
@

-}
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

-- [("event",String "archive"),("status",String "started"),("createdAt",Number 1.534898598419e12),("size",Number 0.0),("partnerId",Number 4.5759482e7),("url",Null),("resolution",String "640x480"),("outputMode",String "composed"),("hasAudio",Bool True),("reason",String ""),("name",Null),("password",String ""),("id",String "e4efbf78-244f-47e7-ae89-640988cac725"),("updatedAt",Number 1.53489859849e12),("sha256sum",String ""),("projectId",Number 4.5759482e7),("sessionId",String "2_MX40NTc1OTQ4Mn5-MTUzNDg5NzQ0MDgwMX44QjZFVFQ4VkhWL05YYUpvRUtlNGFUQkh-fg"),("hasVideo",Bool True),("duration",Number 0.0)]

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


{-|

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']
}
@

-}
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