messente (empty) → 0.1.0.0

raw patch · 4 files changed

+193/−0 lines, 4 filesdep +HTTPdep +basedep +bytestringsetup-changed

Dependencies added: HTTP, base, bytestring, http-conduit, network

Files

LICENSE +21/−0
Messente.hs +152/−0
Setup.hs +2/−0
messente.cabal +18/−0

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 Vjatseslav Gedrovits++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ Messente.hs view

@@ -0,0 +1,152 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}+module Messente+  ( Delivery(..)+  , MessenteError(..)+  , Messente.send+  , Messente.listen+  , Messente.verify+  ) where++import Data.List (intercalate)+import Data.Maybe (fromMaybe)+import Data.Char (digitToInt)+import Data.Typeable+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL++import Network hiding (accept, sClose)+-- Conduit is use to get https working+import Network.HTTP.Conduit+import Network.HTTP (urlDecode, urlEncode)+import Network.Socket hiding (recv)+import Network.Socket.ByteString (sendAll, recv)+import Control.Concurrent+import Control.Exception++servers = [ "api2.messente.com", "api3.messente.com" ]++type SmsID = String++-- |Exceptions for Messente API+data MessenteError+  = WrongCredentials+  | InvalidIP+  | InvalidParameters [(String, String)]+  | InvalidSender String+  | MissingPin+  | ServersDown           -- ^ All servers gave "FAILED 209"+  | Unknown String        -- ^ Just in case. Argument contains http response as it is.+  deriving (Typeable)++instance Exception MessenteError+instance Show MessenteError where+  show WrongCredentials      = "Messente got wrong credentials"+  show InvalidIP             = "This IP is not whitelisted for Messente API"+  show MissingPin            = "PIN code field is missing in the template value"+  show ServersDown           = "All servers answered with \"FAILED 209\""+  show (InvalidParameters p) = "Messente got invalid parameters: " ++ makeQuery p+  show (InvalidSender s    ) = "You must register this sender from Messente API (" ++ s ++ ")"+  show (Unknown       s    ) = "Unknown Messente error: " ++ s++-- |All possible delivery states.+data Delivery+  = Delivered SmsID                 -- ^ Happy final state+  | DeliveryError SmsID Int String  -- ^ Negative final state+  | DeliveryProgress SmsID String   -- ^ Not final state. Informative report.+  deriving (Show)++-- |Sends sms and returns Either error or sms id+-- It takes arguments 'apiUser' 'apiPassword' 'from' 'to' 'content'+send :: String -> String -> Maybe String -> String -> String -> IO (Either (Int, String) SmsID)+send apiUser apiPassword from to content = +  do resp <- doRequest servers $ "/send_sms/?" ++ makeQuery q+     case BL.unpack resp of+       ('O':'K':' ':inf) -> return $ Right $ takeWhile (/=' ') inf+       "ERROR 102"  -> return $ Left (102, "Invalid parameters") -- Left $ InvalidParameters q -- NOTE: can't make difference if problem is with API or this SMS! :(+       "ERROR 111"  -> throw $ InvalidSender $ fromMaybe "unspecified" from+       r            -> throw $ Unknown r+  where+    q  = [ ("username", apiUser)+         , ("password", apiPassword)+         , ("text",     content)+         , ("to",       to)+         ] ++ maybe [] (\f -> [("from", f)]) from++-- |Listens delivery reports+listen :: Int -> (Delivery -> IO ()) -> IO ()+listen port fn =+  withSocketsDo $+    do sock <- listenOn $ PortNumber (fromIntegral port)+       loop sock+  where+    loop sock = do+      (conn, _) <- accept sock+      forkIO $ do+        mesg <- recv conn 9999+        sendAll conn (B.pack okResponse)+        sClose conn+        fn $ parseDeliveryReport mesg+      loop sock+    okResponse = "HTTP/1.0 200 OK"+              ++ "\r\nContent-Type: text/plain"+              ++ "\r\nServer: Messente Haskell Library 0.1" -- TODO version+              ++ "\r\nConnection: close"+              ++ "\r\n\r\n"++-- |Verify SMS delivery.+-- Takes apiUser apiPassword smsId+verify :: String -> String -> SmsID -> IO Delivery+verify apiUser apiPassword id =+  do resp <- doRequest servers ("/get_dlr_response/?" ++ makeQuery q)+     case resp of+       "OK DELIVERED" -> return $ Delivered id+       "OK SENT"      -> return $ DeliveryProgress id   "Unknown"+       "OK FAILED"    -> return $ DeliveryError    id 1 "Unknown"+       "ERROR 102"  -> throw $ InvalidParameters q+       "ERROR 111"  -> throw $ InvalidSender "unknown"+       "ERROR 109"  -> throw   MissingPin+       r            -> throw $ Unknown $ BL.unpack r+  where+    q = [ ("username",    apiUser    )+        , ("password",    apiPassword)+        , ("sms_uniq_id", id         ) ]++doRequest :: [String] -> String -> IO BL.ByteString+doRequest [] _ = throw ServersDown+doRequest (serv:bserv) url = handle prob $ simpleHttp ("https://" ++ serv ++ url) >>= chk+  where+    chk :: BL.ByteString -> IO BL.ByteString+    chk "FAILED 209" = doRequest bserv url+    chk "ERROR 101"  = throw WrongCredentials+    chk "ERROR 103"  = throw InvalidIP+    chk s = return s+    prob :: SomeException -> IO BL.ByteString+    prob e = if null bserv +              then throw e+              else doRequest bserv url++parseDeliveryReport :: B.ByteString -> Delivery+parseDeliveryReport httpMesg =+  status (val "sms_unique_id") (val "status") (val' "stat") (val' "err")+  where+    val key = case lookup key args of +                Just v -> B.unpack v+                _ -> error ("Parameter " ++ B.unpack key ++ " missing from Messente Delivery Report request")+    val' key = fmap B.unpack $ lookup key args+    status id "DELIVERED" _ _ = Delivered id+    status id "SENT"      (Just s) _ = DeliveryProgress id s+    status id "FAILED"    (Just s) (Just code) = DeliveryError id (read code) s+    status id s1 s2 err = error $ "Unknown Messente status: " ++ s1 ++ " " ++ show s2 ++  " " ++ show err+    args = parseQuery $ B.takeWhile (/=' ') $ B.tail $ B.dropWhile (/='?') httpMesg -- "GET /?(.*?) "++makeQuery :: [(String, String)] -> String+makeQuery args = intercalate "&" $ map (\(k,v) -> k ++ "=" ++ urlEncode v) args++parseQuery :: B.ByteString -> [(B.ByteString, B.ByteString)]+parseQuery "" = []+parseQuery query = +    let (x, xs) = breakC '&' query+    in breakC '=' x : parseQuery xs+  where+    breakC c bs = let (a,b) = B.break (==c) bs in (a, B.drop 1 b)+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ messente.cabal view

@@ -0,0 +1,18 @@+name:   messente+version:  0.1.0.0+cabal-Version:  >= 1.8+license:  MIT+license-File: LICENSE+author:   Kaiko Kaur+maintainer: kaiko@zazler.com+homepage: http://github.com/kaiko/messente-haskell+category: API+synopsis: Messente SMS Gateway+build-type: Simple++Library+  Build-Depends: base >= 4.6 && <= 4.7, http-conduit >= 2.0 && <=2.1, bytestring == 0.10.*, network == 2.6.*, HTTP == 4000.2.*+  Exposed-modules:+    Messente+  Extensions: OverloadedStrings, DeriveDataTypeable+