packages feed

servant-smsc-ru (empty) → 0.1.0.0

raw patch · 8 files changed

+616/−0 lines, 8 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed

Dependencies added: HUnit, QuickCheck, aeson, base, bytestring, http-client, http-client-tls, mtl, quickcheck-text, scientific, servant, servant-client, servant-smsc-ru, tasty, tasty-hunit, tasty-quickcheck, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,4 @@+0.1.0.0+=======++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Anton Gushcha (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Anton Gushcha nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,38 @@+# servant-smsc-ru++[![Build Status](https://travis-ci.org/NCrashed/servant-smsc-ru.svg?branch=master)](https://travis-ci.org/NCrashed/servant-smsc-ru)++These are bindings to https://smsc.ru service for sending SMS/MMS message to cell phones.++# How to use++The general API is provided by `genericSmsSend` function, but it is too overengineered to be used+as is. Thats why several simplified wrappers are presented.++First, you need to provide `SmscConfig` value:++``` haskell+cfg <- defaultSmscConfig+let testSmscConfig = cfg {+        smscLogin = "mylogin"+      , smscPassword = "mypass"+      }+```++After that you can send a SMS:++``` haskell+res <- simpleSmsSend testSmscConfig testPhone "Test message"+case res of +  Left er -> printLn $ "message sending: " ++ show er+  Right _ -> return ()+```++Or check how much it would cost to you:++``` haskell+res <- getSimpleSmsCost testSmscConfig testPhone "Test message"+case res of +  Left er -> assertFailure $ "message costing: " <> show er+  Right v -> putStrLn $ "message cost: " <> show v+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-smsc-ru.cabal view
@@ -0,0 +1,72 @@+name:                servant-smsc-ru+version:             0.1.0.0+synopsis:            Servant client for smsc.ru service for sending SMS to cell phones+description:         Please see README.md+homepage:            https://github.com/NCrashed/servant-smsc-ru#readme+license:             BSD3+license-file:        LICENSE+author:              Anton Gushcha+maintainer:          ncrashed@gmail.com+copyright:           2016 Anton Gushcha+category:            Web+build-type:          Simple+extra-source-files:+  README.md +  CHANGELOG.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+    Servant.API.SMSC.RU+    Servant.API.SMSC.RU.API++  build-depends:       +      base >= 4.7 && < 5+    , aeson >= 0.11 && < 0.12+    , bytestring >= 0.10 && < 0.11+    , http-client >= 0.4 && < 0.6+    , http-client-tls >= 0.2 && < 0.4+    , mtl >= 2.2 && < 2.3+    , scientific >= 0.3 && < 0.4+    , servant >= 0.7 && < 0.9+    , servant-client >= 0.7 && < 0.9+    , text >= 1.2 && < 2+    , transformers >= 0.4 && < 0.6++  default-language:    Haskell2010+  default-extensions:+    DataKinds+    DeriveGeneric+    FlexibleInstances+    GeneralizedNewtypeDeriving+    KindSignatures+    OverloadedStrings+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TypeFamilies+    TypeOperators+    TypeSynonymInstances++test-suite test-servant-smsc-ru+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends: +      base+    , aeson+    , HUnit >= 1.3+    , QuickCheck >= 2.8.2+    , quickcheck-text+    , servant-smsc-ru+    , tasty >= 0.11+    , tasty-hunit >= 0.9+    , tasty-quickcheck >= 0.8+    , text+    , bytestring++source-repository head+  type:     git+  location: https://github.com/NCrashed/servant-smsc-ru
+ src/Servant/API/SMSC/RU.hs view
@@ -0,0 +1,243 @@+{-|+Module      : Servant.API.SMSC.RU+Description : Meta module that contains all API for smsc.ru service+Copyright   : (c) Anton Gushcha, 2016+License     : MIT+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : Portable++The module contains general and simplified functions to call <https://smsc.ru smsc.ru> service+for sending SMS/MMS messages.++The general API is provided by 'genericSmsSend' function, but it is too overengineered to be used+as is. Thats why several simplified wrappers are presented.++First, you need to provide 'SmscConfig' value:++@+cfg <- defaultSmscConfig+let testSmscConfig = cfg {+        smscLogin = "mylogin"+      , smscPassword = "mypass"+      }+@++After that you can send a SMS:++@+res <- simpleSmsSend testSmscConfig testPhone "Test message"+case res of +  Left er -> printLn $ "message sending: " ++ show er+  Right _ -> return ()+@++Or check how much it would cost to you:++@+res <- getSimpleSmsCost testSmscConfig testPhone "Test message"+case res of +  Left er -> assertFailure $ "message costing: " <> show er+  Right v -> putStrLn $ "message cost: " <> show v+@++-}+module Servant.API.SMSC.RU(+  -- * API+    SMSCAPI+  -- ** Endpoints+  , SendResponse(..)+  , PhoneResp(..)+  , SendEndpoint+  -- * Client+  , genericSmsSend+  -- ** Simplified+  , SmscConfig(..)+  , defaultSmscConfig+  , simpleSmsSend+  , getSimpleSmsCost +  ) where ++import Control.Monad.Except+import Data.ByteString.Lazy (ByteString)+import Data.Monoid +import Data.Proxy+import Data.Text +import GHC.Generics +import Network.HTTP.Client (Manager, newManager)+import Network.HTTP.Client.TLS+import Servant.API.SMSC.RU.API+import Servant.Client ++import qualified Data.Text as T ++-- | The most generic call to the send endpoint+genericSmsSend :: +     Maybe Text -- ^ login+  -> Maybe Text  -- ^ psw+  -> Maybe Text -- ^ phones+  -> Maybe Text  -- ^ mes+  -> Maybe Text  -- ^ id+  -> Maybe Text  -- ^ sender+  -> Maybe Text -- ^ translit+  -> Maybe Text  -- ^ tinyurl+  -> Maybe Text  -- ^ time+  -> Maybe Text  -- ^ tz+  -> Maybe Double -- ^ period+  -> Maybe Word -- ^ freq+  -> Maybe Word  -- ^ flash+  -> Maybe Text  -- ^ bin+  -> Maybe Word  -- ^ push+  -> Maybe Word  -- ^ hlr+  -> Maybe Word  -- ^ ping+  -> Maybe Word  -- ^ mms+  -> Maybe Word  -- ^ mail+  -> Maybe Word  -- ^ call+  -> Maybe Text  -- ^ voice+  -> Maybe Text  -- ^ param+  -> Maybe Text  -- ^ subj+  -> Maybe Text  -- ^ charset+  -> Maybe Word  -- ^ cost+  -> Maybe Word -- ^ fmt, should be always 3+  -> Maybe Text  -- ^ list+  -> Maybe Text  -- ^ valid+  -> Maybe Word  -- ^ maxsms+  -> Maybe Text  -- ^ imgcode+  -> Maybe Text  -- ^ userip+  -> Maybe Word  -- ^ err+  -> Maybe Word  -- ^ op+  -> Maybe Text -- ^ pp+  -> ByteString -- ^ Request body (voice messages and etc)+  -> Manager -> BaseUrl -> ClientM SendResponse+genericSmsSend = client (Proxy :: Proxy SMSCAPI)++-- | Required common info for smsc API+data SmscConfig = SmscConfig {+  smscLogin :: !Text -- ^ Account login+, smscPassword :: !Text  -- ^ Account password+, smscManager :: !Manager  -- ^ Connection manager (use http-)+, smscBaseUrl :: !BaseUrl+} deriving (Generic)++instance Show SmscConfig where +  show SmscConfig{..} = "SmscConfig {" +    <> "smscLogin = " <> show smscLogin+    <> ", smscPassword = " <> show smscPassword+    <> ", smscManager = <object> "+    <> ", smscBaseUrl = " <> show smscBaseUrl +    <> " }"++defaultSmscConfig :: MonadIO m => m SmscConfig+defaultSmscConfig = do +  mng <- liftIO $ newManager tlsManagerSettings+  return SmscConfig {+      smscLogin = ""+    , smscPassword = ""+    , smscManager = mng +    , smscBaseUrl = BaseUrl {+        baseUrlScheme = Https+      , baseUrlHost = "smsc.ru"+      , baseUrlPort = 443+      , baseUrlPath = ""+      }+    }++-- | Simple send message to given phone+simpleSmsSend :: MonadIO m +  => SmscConfig -- ^ Authorisation and other general config+  -> Text -- ^ Phone+  -> Text -- ^ Message+  -> m (Either Text SendResponse)+simpleSmsSend SmscConfig{..} phone msg = do +  res <- liftIO . runExceptT $ genericSmsSend+    (Just smscLogin) +    (Just smscPassword)+    (Just phone) -- phones+    (Just msg) -- mes+    Nothing -- id+    Nothing -- sender+    Nothing -- translit+    Nothing -- tinyurl+    Nothing -- time+    Nothing -- tz+    Nothing -- period+    Nothing -- freq+    Nothing -- flash+    Nothing -- bin+    Nothing -- push+    Nothing -- hlr+    Nothing -- ping+    Nothing -- mms+    Nothing -- mail+    Nothing -- call+    Nothing -- voice+    Nothing -- param+    Nothing -- subj+    Nothing -- charset+    Nothing -- cost+    (Just 3) -- fmt always 3+    Nothing -- list+    Nothing -- valid+    Nothing -- maxsms+    Nothing -- imgcode+    Nothing -- userip+    Nothing -- err+    Nothing -- op+    Nothing -- pp+    mempty+    smscManager smscBaseUrl+  return $ case res of +    Left e -> Left (T.pack $ show e)+    Right r -> Right r++-- | Getting cost of message without sending+getSimpleSmsCost :: MonadIO m +  => SmscConfig -- ^ Authorisation and other general config+  -> Text -- ^ Phone+  -> Text -- ^ Message+  -> m (Either Text Text)+getSimpleSmsCost SmscConfig{..} phone msg = do +  res <- liftIO . runExceptT $ genericSmsSend+    (Just smscLogin) +    (Just smscPassword)+    (Just phone) -- phones+    (Just msg) -- mes+    Nothing -- id+    Nothing -- sender+    Nothing -- translit+    Nothing -- tinyurl+    Nothing -- time+    Nothing -- tz+    Nothing -- period+    Nothing -- freq+    Nothing -- flash+    Nothing -- bin+    Nothing -- push+    Nothing -- hlr+    Nothing -- ping+    Nothing -- mms+    Nothing -- mail+    Nothing -- call+    Nothing -- voice+    Nothing -- param+    Nothing -- subj+    Nothing -- charset+    (Just 1) -- cost+    (Just 3) -- fmt always 3+    Nothing -- list+    Nothing -- valid+    Nothing -- maxsms+    Nothing -- imgcode+    Nothing -- userip+    Nothing -- err+    Nothing -- op+    Nothing -- pp+    mempty+    smscManager smscBaseUrl+  return $ case res of +    Left e -> Left (T.pack $ show e)+    Right r -> case r of +      se@SendError{} -> Left (T.pack $ show se)+      SendSuccess{..} -> case sendSuccCost of +        Nothing -> Left "No cost in response"+        Just c -> return c
+ src/Servant/API/SMSC/RU/API.hs view
@@ -0,0 +1,156 @@+{-|+Module      : Servant.API.SMSC.RU.API+Description : Contains raw servant API for smsc.ru service+Copyright   : (c) Anton Gushcha, 2016+License     : MIT+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : Portable+-}+module Servant.API.SMSC.RU.API(+  -- * API+    SMSCAPI+  -- ** Endpoints+  , SendResponse(..)+  , PhoneResp(..)+  , SendErrorCode(..)+  , SendEndpoint+  ) where ++import Control.Monad+import Data.Aeson+import Data.Monoid +import Data.Scientific+import Data.Text+import GHC.Generics+import Servant.API ++import Data.ByteString.Lazy (ByteString)++-- | All supported API of smsc.ru service+type SMSCAPI = SendEndpoint++-- | Error type+data SendErrorCode = +    SendParametersError+  | SendInvalidLoginPass+  | SendLowFunds+  | SendBlockedDueErrors+  | SendInvalidDateFormat+  | SendForbiddenMessage+  | SendInvalidPhoneFormat+  | SendMessageCannotBeDelivered+  | SendTooMuchMessages+  deriving (Generic, Show, Eq, Bounded, Enum)++-- | Convert from received error code+fromErrorCode :: Word -> Maybe SendErrorCode+fromErrorCode w = case w of +  1 -> Just SendParametersError+  2 -> Just SendInvalidLoginPass+  3 -> Just SendLowFunds+  4 -> Just SendBlockedDueErrors+  5 -> Just SendInvalidDateFormat+  6 -> Just SendForbiddenMessage+  7 -> Just SendInvalidPhoneFormat+  8 -> Just SendMessageCannotBeDelivered+  9 -> Just SendTooMuchMessages+  _ -> Nothing++instance FromJSON SendErrorCode where +  parseJSON (Number s) = case fromErrorCode =<< toBoundedInteger s of +    Nothing -> fail $ "unknown error code " <> show s+    Just c -> return c +  parseJSON _ = mzero++-- | Additional info about phone number+data PhoneResp = PhoneResp {+  phoneNumber :: !Text +, phoneMccmnc :: !Text +, phoneCost :: !Text +, phoneStatus :: !Text +, phoneError :: !Text+} deriving (Generic, Show)++instance FromJSON PhoneResp where +  parseJSON (Object o) = PhoneResp +    <$> o .: "phone"+    <*> o .: "mccmnc"+    <*> o .: "cost"+    <*> o .: "status"+    <*> o .: "error"+  parseJSON _ = mzero++-- | Response for 'SendEndpoint'+data SendResponse = +    -- | Server returned error payload+    SendError {+      sendError :: !Text -- ^ Desciption of error+    , sendErrorCode :: !SendErrorCode -- ^ Error code+    , sendErrorId :: !(Maybe Text) -- ^ ID of failed message+    }+    -- | Server retunred success payload+  | SendSuccess {+      sendSuccId :: !(Maybe Word) -- ^ ID of sended message+    , sendSuccCnt :: !Word -- ^ Count of messages sended (huge payloads are splitted)+    , sendSuccCost :: !(Maybe Text) -- ^ Cost of sending+    , sendSuccBalance :: !(Maybe Text) -- ^ Funds of the account left after the call+    , sendSuccPhones :: !(Maybe [PhoneResp]) -- ^ Additional info by phone number+    }+  deriving (Generic, Show)++instance FromJSON SendResponse where +  parseJSON (Object o) = do +    merr <- o .:? "error"+    case merr of +      Nothing -> SendSuccess+        <$> o .:? "id"+        <*> o .: "cnt"+        <*> o .:? "cost"+        <*> o .:? "balance"+        <*> o .:? "phones"+      Just err -> SendError err +        <$> o .: "error_code"+        <*> o .:? "id"+  parseJSON _ = mzero+  +-- | Endpoint for sending sms, this is low-level most general +-- API that is used to built small helper functions.+type SendEndpoint = "sys" :> "send.php"+  :> QueryParam "login" Text+  :> QueryParam "psw" Text +  :> QueryParam "phones" Text+  :> QueryParam "mes" Text +  -- additional parameters+  :> QueryParam "id" Text +  :> QueryParam "sender" Text +  :> QueryParam "translit" Text+  :> QueryParam "tinyurl" Text +  :> QueryParam "time" Text +  :> QueryParam "tz" Text +  :> QueryParam "period" Double+  :> QueryParam "freq" Word+  :> QueryParam "flash" Word +  :> QueryParam "bin" Text +  :> QueryParam "push" Word +  :> QueryParam "hlr" Word +  :> QueryParam "ping" Word +  :> QueryParam "mms" Word +  :> QueryParam "mail" Word +  :> QueryParam "call" Word +  :> QueryParam "voice" Text +  :> QueryParam "param" Text +  :> QueryParam "subj" Text +  :> QueryParam "charset" Text +  :> QueryParam "cost" Word +  :> QueryParam "fmt" Word -- should be always 3 +  :> QueryParam "list" Text +  :> QueryParam "valid" Text +  :> QueryParam "maxsms" Word +  :> QueryParam "imgcode" Text +  :> QueryParam "userip" Text +  :> QueryParam "err" Word +  :> QueryParam "op" Word +  :> QueryParam "pp" Text+  :> ReqBody '[OctetStream] ByteString+  :> Post '[JSON] SendResponse
+ test/Main.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+module Main where++import Control.Monad +import Data.Aeson+import Data.Either+import Data.Maybe+import Data.Monoid+import Data.Text +import System.IO.Unsafe+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC++import qualified Data.ByteString.Lazy as BS ++import Servant.API.SMSC.RU++data TestConfig = TestConfig Text Text Text++instance FromJSON TestConfig where +  parseJSON (Object o) = TestConfig +    <$> o .: "login"+    <*> o .: "password"+    <*> o .: "phone"+  parseJSON _ = mzero++testConfig :: TestConfig +testConfig = fromJust $ decode' $ unsafePerformIO (BS.readFile "smsc.test.json")++-- | Load config from file +testSmscConfig :: SmscConfig+testSmscConfig = (unsafePerformIO defaultSmscConfig) {+    smscLogin = login+  , smscPassword = pass+  }+  where +  TestConfig login pass _ = testConfig++-- | Phone number we test with+testPhone :: Text +testPhone = let TestConfig _ _ phone = testConfig in phone ++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [qcProperties, unitTests]++qcProperties :: TestTree +qcProperties = testGroup "Properties" [ +      testCase "Simple send" $ do+      res <- simpleSmsSend testSmscConfig testPhone "Test message"+      case res of +        Left er -> assertFailure $ "message sending: " <> show er+        Right _ -> return ()+    , testCase "Simple cost" $ do +      res <- getSimpleSmsCost testSmscConfig testPhone "Test message"+      case res of +        Left er -> assertFailure $ "message costing: " <> show er+        Right v -> putStrLn $ "message cost: " <> show v+  ]++unitTests :: TestTree +unitTests = testGroup "Unit tests" [++  ]