opentok 0.0.4 → 0.0.5

raw patch · 11 files changed

+265/−68 lines, 11 filesdep +QuickCheckdep +hspecdep +opentokdep ~SHAdep ~aesondep ~aeson-casingPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, hspec, opentok, quickcheck-instances, split, tasty, tasty-hspec, tasty-quickcheck

Dependency ranges changed: SHA, aeson, aeson-casing, aeson-compat, base, base-compat, base64-string, bytestring, containers, convertible, either, http-client, http-client-tls, http-conduit, http-types, iproute, jose, lens, monad-time, strings, text, time, transformers, unordered-containers, utf8-string, uuid

API changes (from Hackage documentation)

Files

• opentok.cabal +47/−1
• src/OpenTok.hs +2/−1
• src/OpenTok/Archive.hs +8/−38
• src/OpenTok/Client.hs +15/−12
• src/OpenTok/Session.hs +17/−10
• src/OpenTok/Token.hs +9/−6
• test/Archive.hs +30/−0
• test/Config.hs +9/−0
• test/Session.hs +51/−0
• test/Test.hs +19/−0
• test/Token.hs +58/−0

@@ -1,5 +1,5 @@ name: opentok-version: 0.0.4+version: 0.0.5 synopsis: An OpenTok SDK for Haskell description:   .@@ -49,6 +49,52 @@       , transformers >= 0.5.2.0     if flag(documentation)         build-depends: hscolour == 1.20.*+++test-suite tests+  default-language:   Haskell2010+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Test.hs+  other-modules:      Session, Token, Archive, Config++  build-depends:+    base+    , base-compat+    , aeson+    , aeson-casing+    , aeson-compat+    , base64-string+    , bytestring+    , containers+    , convertible+    , either+    , http-client+    , http-client-tls+    , http-conduit+    , http-types+    , iproute+    , jose+    , lens+    , monad-time+    , unordered-containers+    , SHA+    , strings+    , uuid+    , utf8-string+    , text+    , time+    , transformers++    , opentok++    , hspec >= 2.0.0+    , split >= 0.2.3+    , QuickCheck >= 2+    , quickcheck-instances+    , tasty+    , tasty-hspec >= 1.0+    , tasty-quickcheck  flag documentation     default: True

@@ -6,7 +6,8 @@   , createSession   , generateToken   , Token-  , TokenOptions+  , Role(..)+  , TokenOptions(..)   , tokenOpts   , startArchive   , stopArchive

@@ -5,45 +5,15 @@ {-# LANGUAGE TemplateHaskell #-}  module OpenTok.Archive-  ( OutputMode(Composed, Individual)-  , ArchiveResolution(SD, HD)-  , ArchiveOptions-    ( _hasAudio-    , _hasAudio-    , _name-    , _outputMode-    , _resolution-    , _sessionId-    )+  ( OutputMode(..)+  , ArchiveResolution(..)+  , ArchiveOptions(..)   , archiveOpts-  , ArchiveStatus(Available, Expired, Failed, Paused, Started, Stopped, Uploaded)-  , Archive-    ( id-    , status-    , createdAt-    , size-    , partnerId-    , url-    , resolution-    , outputMode-    , hasAudio-    , hasVideo-    , reason-    , name-    , updatedAt-    , duration-    , sessionId-    )-  , ListArchiveOptions-   ( _forSessionId-   , _count-   , _offset-   )+  , ArchiveStatus(..)+  , Archive(..)+  , ListArchiveOptions(..)   , listArchiveOpts-  , ArchiveCollection-  ( count-  , items-  )+  , ArchiveCollection(..)   , start   , stop   , list@@ -130,6 +100,7 @@ @ ArchiveOptions   { _hasVideo   = 'True'+  , _hasVideo   = 'True'   , _name       = 'Nothing'   , _outputMode = 'Composed'   , _resolution = 'SD'@@ -266,7 +237,6 @@ ArchiveCollection {   count :: 'Int'   items :: ['Archive']-  id :: 'String' } @ 

@@ -77,6 +77,9 @@   _secret :: String } +-- | HTTP Verbs+data Method = GET | POST | DELETE deriving (Show)+ -- | Create claims for a JWT mkClaims :: String -> IO ClaimsSet mkClaims projectKey = do@@ -108,7 +111,7 @@ buildHeaders :: SignedJWT -> RequestHeaders buildHeaders jwt =   [-    ( "Content-Type", "application/json")+    ("Content-Type"  , "application/json")   , ("Accept"        , "application/json")   , ("X-OPENTOK-AUTH", toStrict $ encodeCompact jwt)   ]@@ -140,11 +143,11 @@     204 -> pure $ Right "Ok"     _   -> pure $ Left $ ClientError sc "Failed to delete resource" -buildRequest :: Path -> SignedJWT -> IO Request-buildRequest p jwt = do+buildRequest :: Method -> Path -> SignedJWT -> IO Request+buildRequest m p jwt = do   initialRequest <- parseRequest $ "https://api.opentok.com" <> p   let buildFn = if "v2" `isInfixOf` p then buildHeaders else buildV1Headers-  pure $ initialRequest { method = "POST", requestHeaders = buildFn jwt }+  pure $ initialRequest { method = C8.pack $ show m, requestHeaders = buildFn jwt }  -- | Make a POST request post :: (FromJSON a) => Client -> Path -> IO (Either ClientError a)@@ -153,7 +156,7 @@   case eitherJWT of     Left e -> pure $ Left e     Right jwt -> do-      request <- buildRequest p jwt+      request <- buildRequest POST p jwt       execute request  -- | Make a POST request with a body@@ -163,25 +166,25 @@   case eitherJWT of     Left e -> pure $ Left $ e     Right jwt -> do-      request <- buildRequest p jwt+      request <- buildRequest POST p jwt       execute $ request { requestBody = RequestBodyLBS $ encode b } --- | Make a GET request with a body+-- | Make a GET request 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" }+      request <- buildRequest GET p jwt+      execute $ request --- | Make a GET request with a body+-- | Make a DELETE request 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" }+      request <- buildRequest DELETE p jwt+      deleteResource $ request

@@ -2,13 +2,14 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  module OpenTok.Session   (-    ArchiveMode(Manual, Always)-  , MediaMode(Relayed, Routed)-  , SessionOptions(_mediaMode, _archiveMode, _location)-  , Session(apiKey, sessionId, mediaMode, archiveMode)+    ArchiveMode(..)+  , MediaMode(..)+  , SessionOptions(..)+  , Session(..)   , sessionOpts   , create   )@@ -21,6 +22,7 @@ import           Data.Aeson.Types import           Data.Aeson.TH import           Data.Data+import           Data.IP                        ( IPv4 ) import           Data.Strings                   ( strToLower ) import           GHC.Generics @@ -30,7 +32,7 @@ -- | Relayed sessions will attempt to use peer-to-peer (p2p) connections. -- -- Routed sessions will use the <https://tokbox.com/platform/multi-party OpenTok Media Router>-data MediaMode = Relayed | Routed deriving (Data, Generic, Typeable)+data MediaMode = Relayed | Routed deriving (Data, Eq, Generic, Typeable)  instance Show MediaMode where   show = strToLower . showConstr . toConstr@@ -39,7 +41,7 @@  -- | Manual, as it implies, requires archives to be manually started and stopped. -- Always means that archives will automatically be created.-data ArchiveMode = Manual | Always deriving (Data, Generic, Typeable)+data ArchiveMode = Manual | Always deriving (Data, Eq, Generic, Typeable)  instance Show ArchiveMode where   show = strToLower . showConstr . toConstr@@ -53,15 +55,18 @@ -- -- 'ArchiveMode' specifies how archives will be created. ----- An 'IPAddress' may be provided as a location hint which will--- be when choosing an OpenTok Media Router for the session.+-- An 'IPv4' address may be provided as a location hint which will+-- be used in selecting an OpenTok Media Router for the session. data SessionOptions = SessionOptions {   _mediaMode :: MediaMode,   _archiveMode :: ArchiveMode,-  _location :: Maybe IPAddress+  _location :: Maybe IPv4 } deriving(Show, Generic) +instance ToJSON IPv4 where+  toJSON = genericToJSON defaultOptions + instance ToJSON SessionOptions where   toJSON = genericToJSON defaultOptions     { omitNothingFields = True, fieldLabelModifier = drop 1 }@@ -99,7 +104,8 @@   apiKey :: String,   sessionId :: String,   mediaMode :: MediaMode,-  archiveMode :: ArchiveMode+  archiveMode :: ArchiveMode,+  location :: Maybe IPv4 } deriving (Show)  data SessionProperties = SessionProperties {@@ -120,6 +126,7 @@   , sessionId   = _sessionId props   , mediaMode   = _mediaMode opts   , archiveMode = _archiveMode opts+  , location    = _location opts   }  -- | Create a new OpenTok Session

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}  module OpenTok.Token where @@ -21,21 +22,23 @@ import qualified Data.ByteString.Lazy.Char8    as L8                                                 ( pack,                                                   fromStrict )+import           Data.Data import           Data.Semigroup                 ( (<>) )+import           Data.Strings                   ( strToLower ) import           Data.Time.Clock import           Data.UUID                      ( ) import           Data.UUID.V4                   ( nextRandom ) import qualified Data.Text                     as T import           GHC.Generics import           Network.HTTP.Types             ( renderQuery )+ import           OpenTok.Util import           OpenTok.Types -data Role = Subscriber | Publisher | Moderator+data Role = Subscriber | Publisher | Moderator deriving (Data, Typeable)+ instance Show Role where-  show Subscriber = "subscriber"-  show Publisher = "publisher"-  show Moderator = "moderator"+  show = strToLower . showConstr . toConstr  -- | Information on user roles and other options can be found at https://tokbox.com/developer/guides/create-token/ data TokenOptions = TokenOptions {@@ -89,7 +92,7 @@   Nothing     -> pure True   Just expire -> do     now <- getCurrentTime-    let maxExpire = addUTCTime (30 * 86400) now+    let maxExpire = addUTCTime (days 30) now     pure $ expire >= now && expire <= maxExpire  -- | Remove pairs with Nothing values before creating query string@@ -106,7 +109,7 @@   now   <- getCurrentTime   nonce <- nextRandom   let tokenSentinel = "T1=="-  let expire = maybe (utcToBS $ addUTCTime 86400 now) utcToBS (_expireTime opts)+  let expire = maybe (utcToBS $ addUTCTime (days 1) now) utcToBS (_expireTime opts)   let     options =       [ ("session_id"     , Just $ C8.pack sessionId)

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Archive(spec) where++import            Control.Arrow+import            Control.Lens+import            Control.Lens.Extras         ( is )+import            Data.Either.Combinators     ( fromRight )+import            Data.List.Split+import            Test.Hspec++import            Config+import            OpenTok+import            OpenTok.Archive+import            OpenTok.Types++ot :: OpenTok+ot = opentok testKey testSecret++spec :: Spec+spec = do+  listArchivesSpec++listArchivesSpec :: Spec+listArchivesSpec = describe "listArchives" $ do+  it "should return an archive collection" $ do+    eArchives <- listArchives ot listArchiveOpts+    eArchives `shouldSatisfy` is _Right++

@@ -0,0 +1,9 @@+module Config where++import OpenTok.Types++testKey :: APIKey+testKey = "45759482"++testSecret :: APISecret+testSecret = "ab7d7b9e00d412a9760cf4ae887908a989cc8dbb"

@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Session(spec) where++import Control.Arrow+import Control.Lens+import Control.Lens.Extras (is)+import Data.IP+import Test.Hspec++import Config+import OpenTok+import OpenTok.Session+import OpenTok.Types++ot :: OpenTok+ot = opentok testKey testSecret++spec :: Spec+spec = do+  defaultSessionSpec+  customSessionSpec+  invalidCredentialsSpec++defaultSessionSpec :: Spec+defaultSessionSpec = describe "A session created with default options" $ do+  it "should have default session properties" $ do+    session <- createSession ot sessionOpts+    session `shouldSatisfy` is _Right+    right mediaMode session `shouldBe` Right Relayed+    right archiveMode session `shouldBe` Right Manual+    right location session `shouldBe` Right Nothing++customSessionSpec :: Spec+customSessionSpec = describe "A session created with custom options" $ do+  it "should have matching session properties" $ do+    let loc = Just $ ipv4 "10.1.200.30"+    session <- createSession ot sessionOpts { _mediaMode = Routed, _archiveMode = Always, _location = loc }+    session `shouldSatisfy` is _Right+    right mediaMode session `shouldBe` Right Routed+    right archiveMode session `shouldBe` Right Always+    right location session `shouldBe` Right loc++invalidCredentialsSpec :: Spec+invalidCredentialsSpec = describe "A session created with invalid credentials" $ do+  it "should return an error" $ do+    let invalidOT = opentok "123456" "123456789123456789123456789"+    session <- createSession invalidOT sessionOpts+    session `shouldSatisfy` is _Left++

@@ -0,0 +1,19 @@+import Test.Tasty+import Test.Tasty.Hspec+import Test.Tasty.QuickCheck++import Archive+import Session+import Token++main :: IO ()+main = do+  unitTests <- unitTestsIO+  defaultMain $ testGroup "Tests" [unitTests]++unitTestsIO :: IO TestTree+unitTestsIO = do+  session <- testSpec "Session" Session.spec+  token <- testSpec "Token" Token.spec+  archive <- testSpec "Archive" Archive.spec+  return $ testGroup "Unit tests" [session, token, archive]

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++module Token(spec) where++import qualified  Codec.Binary.Base64.String  as B64+import            Control.Arrow+import            Control.Lens+import            Control.Lens.Extras         ( is )+import            Data.Either.Combinators     ( fromRight )+import            Data.List.Split+import            Test.Hspec++import            Config+import            OpenTok+import            OpenTok.Session+import            OpenTok.Types++ot :: OpenTok+ot = opentok testKey testSecret++sessionRequest :: IO (Either OTError Session)+sessionRequest = createSession ot sessionOpts++tokenParts :: Either OTError Token -> [String]+tokenParts et = fromRight [] (right (splitOn "&" . B64.decode . drop 4) et)++extractValue :: String -> Maybe String+extractValue p = splitOn "=" p ^? element 1++spec :: Spec+spec = do+  defaultTokenSpec+  customTokenSpec++defaultTokenSpec :: Spec+defaultTokenSpec = describe "A token created with default options" $ do+  it "should have default connection properties" $ do+    eSession <- sessionRequest+    eToken   <- generateToken ot (fromRight "" (right sessionId eSession)) tokenOpts+    let parts = tokenParts eToken+    let role = (parts ^? element 5) >>= extractValue+    let connectionData = (parts ^? element 6) >>= extractValue+    role `shouldBe` Just "publisher"+    connectionData `shouldBe` Nothing++customTokenSpec :: Spec+customTokenSpec = describe "A token created with custom options" $ do+  it "should have those properties encoded" $ do+    let opts = tokenOpts { _role = Moderator, _connectionData = Just ("foo" :: String) }+    eSession <- sessionRequest+    eToken   <- generateToken ot (fromRight "" (right sessionId eSession)) opts+    let parts = tokenParts eToken+    let role = (parts ^? element 5) >>= extractValue+    let connectionData = (parts ^? element 6) >>= extractValue+    role `shouldBe` Just "moderator"+    connectionData `shouldBe` Just "foo"++