plivo (empty) → 0.1.0.0
raw patch · 4 files changed
+280/−0 lines, 4 filesdep +aesondep +basedep +blaze-buildersetup-changed
Dependencies added: aeson, base, blaze-builder, bytestring, errors, http-streams, http-types, io-streams, network, old-locale, time, unexceptionalio
Files
- COPYING +13/−0
- Plivo.hs +226/−0
- Setup.hs +2/−0
- plivo.cabal +39/−0
+ COPYING view
@@ -0,0 +1,13 @@+Copyright © 2013, Stephen Paul Weber <singpolyma.net>++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ Plivo.hs view
@@ -0,0 +1,226 @@+module Plivo (+ callAPI,+ APIError(..),+ InclusiveOrdering(..),+ -- * Enpoints+ CreateOutboundCall(..),+ createOutboundCall,+ GetCompletedCalls(..),+ getCompletedCalls+) where++import Prelude hiding (Ordering(..))+import Data.Maybe (catMaybes)+import Data.List (intercalate)+import Data.String (IsString, fromString)+import UnexceptionalIO (fromIO, runUnexceptionalIO)+import Control.Exception (fromException)+import Control.Error (EitherT, fmapLT, throwT, runEitherT)+import Network.URI (URI(..), URIAuth(..))+import Network.Http.Client (withConnection, establishConnection, sendRequest, buildRequest, http, setAccept, setContentType, Response, receiveResponse, RequestBuilder, inputStreamBody, emptyBody, getStatusCode, setAuthorizationBasic, setContentLength)+import qualified Network.Http.Client as HttpStreams+import Blaze.ByteString.Builder (Builder)+import System.IO.Streams (OutputStream, InputStream, fromLazyByteString)+import System.IO.Streams.Attoparsec (parseFromStream, ParseException(..))+import Network.HTTP.Types.QueryLike (QueryLike, toQuery, toQueryValue)+import Network.HTTP.Types.URI (renderQuery)+import Network.HTTP.Types.Method (Method)+import Network.HTTP.Types.Status (Status)+import Data.Aeson (encode, ToJSON, toJSON, FromJSON, fromJSON, Result(..), object, (.=), json', Value)+import Data.Time (UTCTime, formatTime)+import System.Locale (defaultTimeLocale)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LZ+import qualified Data.ByteString.Char8 as BS8 -- eww++s :: (IsString a) => String -> a+s = fromString++class Endpoint a where+ endpoint :: String -> RequestBuilder () -> a -> IO (Either APIError Value)++-- | The endpoint to place an outbound call+data CreateOutboundCall = CreateOutboundCall {+ from :: String,+ to :: String,+ answer_url :: URI,+ answer_method :: Maybe Method,+ ring_url :: Maybe URI,+ ring_method :: Maybe Method,+ hangup_url :: Maybe URI,+ hangup_method :: Maybe Method,+ fallback_url :: Maybe URI,+ fallback_method :: Maybe Method,+ caller_name :: Maybe String,+ send_digits :: Maybe String,+ send_on_preanswer :: Maybe Bool,+ time_limit :: Maybe Int,+ hangup_on_ring :: Maybe Int,+ machine_detection :: Maybe String,+ machine_detection_time :: Maybe Int,+ sip_headers :: [(String,String)],+ ring_timeout :: Maybe Int+ } deriving (Show, Eq)++-- | Helper for constructing simple 'MakeCall'+createOutboundCall ::+ String -- ^ from+ -> String -- ^ to+ -> URI -- ^ answer_url+ -> CreateOutboundCall+createOutboundCall from to answer_url = CreateOutboundCall from to answer_url+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing Nothing Nothing [] Nothing++instance ToJSON CreateOutboundCall where+ toJSON (CreateOutboundCall from to answer_url answer_method ring_url+ ring_method hangup_url hangup_method fallback_url fallback_method+ caller_name send_digits send_on_preanswer time_limit hangup_on_ring+ machine_detection machine_detection_time sip_headers ring_timeout+ ) = object $ catMaybes [+ Just $ s"from" .= from,+ Just $ s"to" .= to,+ Just $ s"answer_url" .= show answer_url,+ fmap (s"answer_method" .=) answer_method,+ fmap ((s"ring_url" .=) . show) ring_url,+ fmap (s"ring_method" .=) ring_method,+ fmap ((s"hangup_url" .=) . show) hangup_url,+ fmap (s"hangup_method" .=) hangup_method,+ fmap ((s"fallback_url" .=) . show) fallback_url,+ fmap (s"fallback_method" .=) fallback_method,+ fmap (s"caller_name" .=) caller_name,+ fmap (s"send_digits" .=) send_digits,+ fmap (s"send_on_preanswer" .=) send_on_preanswer,+ fmap (s"time_limit" .=) time_limit,+ fmap (s"hangup_on_ring" .=) hangup_on_ring,+ fmap (s"machine_detection" .=) machine_detection,+ fmap (s"machine_detection_time" .=) machine_detection_time,+ fmap (s"sip_headers" .=) (sipFmt sip_headers),+ fmap (s"ring_timeout" .=) ring_timeout+ ]+ where+ sipFmt [] = Nothing+ sipFmt xs = Just $ intercalate "," $ map (\(k,v) -> k ++ "=" ++ v) xs++instance Endpoint CreateOutboundCall where+ endpoint aid = post (apiCall ("Account/" ++ aid ++ "/Call/"))++data InclusiveOrdering = EQ | LT | LTE | GT | GTE deriving (Show, Eq)++orderSuf :: InclusiveOrdering -> String+orderSuf EQ = ""+orderSuf LT = "__lt"+orderSuf LTE = "__lte"+orderSuf GT = "__gt"+orderSuf GTE = "__gte"++-- | The endpoint to list completed calls+data GetCompletedCalls = GetCompletedCalls {+ subaccount :: Maybe String,+ call_direction :: Maybe String,+ from_number :: Maybe String,+ to_number :: Maybe String,+ bill_duration :: Maybe (InclusiveOrdering, Int),+ end_time :: Maybe (InclusiveOrdering, UTCTime),+ limit :: Maybe Int,+ offset :: Maybe Int+ } deriving (Eq, Show)++-- | Helper for constructing simple 'GetCompletedCalls'+getCompletedCalls :: GetCompletedCalls+getCompletedCalls = GetCompletedCalls Nothing Nothing Nothing Nothing Nothing+ Nothing Nothing Nothing++instance QueryLike GetCompletedCalls where+ toQuery (GetCompletedCalls subaccount call_duration from_number to_number+ bill_duration end_time limit offset) = catMaybes [+ fmap (k "subaccount") subaccount,+ fmap (k "call_duration") call_duration,+ fmap (k "from_number") from_number,+ fmap (k "to_number") to_number,+ fmap (\(o,d)-> k ("bill_duration"++orderSuf o) (show d)) bill_duration,+ fmap (\(o,d)-> k ("end_time"++orderSuf o) (utcFmt d)) end_time,+ fmap (k "limit" . show) limit,+ fmap (k "offset" . show) offset+ ]+ where+ utcFmt = formatTime defaultTimeLocale "%Y-%m-%d %H:%M[:%S[%Q]]"+ k str = (,) (fromString str) . toQueryValue++instance Endpoint GetCompletedCalls where+ endpoint aid = get (apiCall ("Account/" ++ aid ++ "/Call/"))++-- | Call a Plivo API endpoint+--+-- You must wrap your app in a call to 'OpenSSL.withOpenSSL'+callAPI :: (Endpoint a) =>+ String -- ^ AuthID+ -> String -- ^ AuthToken+ -> a -- ^ Endpoint data+ -> IO (Either APIError Value)+callAPI aid atok = endpoint aid auth+ where+ -- These should be ASCII+ auth = setAuthorizationBasic (BS8.pack aid) (BS8.pack atok)++-- Construct URIs++baseURI :: URI+baseURI = URI "https:" (Just $ URIAuth "" "api.plivo.com" "") "/v1/" "" ""++apiCall :: String -> URI+apiCall ('/':path) = apiCall path+apiCall path = baseURI { uriPath = uriPath baseURI ++ path }++-- HTTP requests++post :: (ToJSON a, FromJSON b) => URI -> RequestBuilder () -> a -> IO (Either APIError b)+post uri req payload = do+ let req' = do+ setAccept (BS8.pack "application/json")+ setContentType (BS8.pack "application/json")+ setContentLength (LZ.length body)+ req+ bodyStream <- fromLazyByteString body+ oneShotHTTP HttpStreams.POST uri req' (inputStreamBody bodyStream) responseHandler+ where+ body = encode payload++get :: (QueryLike a, FromJSON b) => URI -> RequestBuilder () -> a -> IO (Either APIError b)+get uri req payload = do+ let req' = do+ setAccept (BS8.pack "application/json")+ req+ oneShotHTTP HttpStreams.GET uri' req' emptyBody responseHandler+ where+ uri' = uri { uriQuery = BS8.unpack $ renderQuery True (toQuery payload)}++data APIError = APIParamError | APIAuthError | APINotFoundError | APIParseError | APIRequestError Status | APIOtherError+ deriving (Show, Eq)++responseHandler :: (FromJSON a) => Response -> InputStream ByteString -> IO (Either APIError a)+responseHandler resp i = runUnexceptionalIO $ runEitherT $ do+ case getStatusCode resp of+ code | code >= 200 && code < 300 -> return ()+ 400 -> throwT APIParamError+ 401 -> throwT APIAuthError+ 404 -> throwT APINotFoundError+ code -> throwT $ APIRequestError $ toEnum code+ v <- fmapLT (handle . fromException) $ fromIO $ parseFromStream json' i+ case fromJSON v of+ Success a -> return a+ Error _ -> throwT APIParseError+ where+ handle (Just (ParseException _)) = APIParseError+ handle _ = APIOtherError++oneShotHTTP :: HttpStreams.Method -> URI -> RequestBuilder () -> (OutputStream Builder -> IO ()) -> (Response -> InputStream ByteString -> IO b) -> IO b+oneShotHTTP method uri req body handler = do+ req' <- buildRequest $ do+ http method (BS8.pack $ uriPath uri)+ req+ withConnection (establishConnection url) $ \conn -> do+ sendRequest conn req' body+ receiveResponse conn handler+ where+ url = BS8.pack $ show uri -- URI can only have ASCII, so should be safe
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ plivo.cabal view
@@ -0,0 +1,39 @@+name: plivo+version: 0.1.0.0+cabal-version: >=1.8+license: OtherLicense+license-file: COPYING+copyright: © 2013 Stephen Paul Weber+category: Services+author: Stephen Paul Weber <singpolyma@singpolyma.net>+maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>+stability: experimental+build-type: Simple+homepage: https://github.com/singpolyma/plivo-haskell+bug-reports: http://github.com/singpolyma/plivo-haskell/issues+synopsis: Plivo API wrapper for Haskell+description:+ This package provides types representing requests to Plivo API endpoints+ and a function that calls the endpoints correctly, given the request.++library+ exposed-modules:+ Plivo++ build-depends:+ base == 4.*,+ network,+ http-types,+ http-streams,+ io-streams,+ blaze-builder,+ bytestring,+ aeson,+ time,+ old-locale,+ errors,+ unexceptionalio++source-repository head+ type: git+ location: git://github.com/singpolyma/plivo-haskell.git