smsaero 0.4.1 → 0.5
raw patch · 7 files changed
+422/−169 lines, 7 filesdep +containersdep +http-api-datadep +http-clientdep −eitherdep −lensdep ~servant
Dependencies added: containers, http-api-data, http-client
Dependencies removed: either, lens
Dependency ranges changed: servant
Files
- CHANGELOG.md +8/−0
- smsaero.cabal +7/−5
- src/SMSAero.hs +3/−1
- src/SMSAero/API.hs +154/−101
- src/SMSAero/Client.hs +128/−18
- src/SMSAero/Types.hs +122/−0
- src/SMSAero/Utils.hs +0/−44
CHANGELOG.md view
@@ -1,3 +1,11 @@+0.5+---+* Switch to `servant-0.7` (see [#5](https://github.com/GetShopTV/smsaero/pull/5));+* Update to the latest SMSAero API (see [#7](https://github.com/GetShopTV/smsaero/pull/7) and [#9](https://github.com/GetShopTV/smsaero/pull/9) and [#10](https://github.com/GetShopTV/smsaero/pull/10)):+ * Add `type` parameter;+ * Add groups, contacts and blacklist API;+ * Add API for tarif and message status checking.+ 0.4.1 --- * Add `Eq` instances
smsaero.cabal view
@@ -1,5 +1,5 @@ name: smsaero-version: 0.4.1+version: 0.5 synopsis: SMSAero API and HTTP client based on servant library. description: Please see README.md homepage: https://github.com/GetShopTV/smsaero@@ -18,21 +18,23 @@ cabal-version: >=1.10 library+ ghc-options: -Wall hs-source-dirs: src exposed-modules: SMSAero SMSAero.API SMSAero.Client- SMSAero.Utils+ SMSAero.Types build-depends: base >= 4.7 && < 5- , either- , servant == 0.4.*+ , servant >= 0.7.1 , servant-client , servant-docs+ , http-api-data >= 0.2.3+ , http-client , aeson , text , time- , lens+ , containers default-language: Haskell2010 source-repository head
src/SMSAero.hs view
@@ -8,8 +8,10 @@ -- SMSAero API and HTTP client. module SMSAero ( module SMSAero.API,- module SMSAero.Client+ module SMSAero.Client,+ module SMSAero.Types, ) where import SMSAero.API+import SMSAero.Types import SMSAero.Client
src/SMSAero/API.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -22,51 +23,60 @@ -- * API SMSAeroAPI, SendApi,+ SendToGroupApi, StatusApi,+ GroupApi,+ PhoneApi,+ BlacklistApi, -- * Combinators SmsAeroJson, AnswerJson, RequireAuth, RequiredQueryParam, SmsAeroGet,- -- * Types- SMSAeroAuth(..),- Signature(..),- MessageId(..),- MessageBody(..),- Phone(..),- SMSAeroDate(..), -- * Responses SmsAeroResponse(..), SendResponse(..), MessageStatus(..),+ CheckSendingResponse, BalanceResponse(..),+ CheckTariffResponse, SendersResponse(..), SignResponse(..),+ GroupResponse(..),+ PhoneResponse(..),+ BlacklistResponse(..), ) where import Data.Aeson-import Data.Int (Int64) import Data.Proxy import Data.Time (UTCTime(UTCTime)) import Data.Time.Calendar (fromGregorian)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime) import Data.Text (Text) import qualified Data.Text as Text +import Data.Map (Map)+import qualified Data.Map as Map++import Data.Maybe (catMaybes)+ import Control.Applicative+import Control.Arrow ((***)) import GHC.TypeLits (Symbol, KnownSymbol)-import Text.Read (readMaybe) import Servant.API import Servant.Client import Servant.Docs-import Control.Lens (over, (|>))+import Servant.Docs.Internal (_params) +import Web.HttpApiData+ import GHC.Generics +import SMSAero.Types+ -- | Content type for SMSAero JSON answer (it has JSON body but "text/plain" Content-Type). data SmsAeroJson @@ -82,9 +92,9 @@ -- | Like 'QueryParam', but always required. data RequiredQueryParam (sym :: Symbol) a -instance (HasClient sub, KnownSymbol sym, ToText a) => HasClient (RequiredQueryParam sym a :> sub) where+instance (HasClient sub, KnownSymbol sym, ToHttpApiData a) => HasClient (RequiredQueryParam sym a :> sub) where type Client (RequiredQueryParam sym a :> sub) = a -> Client sub- clientWithRoute _ req baseurl param = clientWithRoute (Proxy :: Proxy (QueryParam sym a :> sub)) req baseurl (Just param)+ clientWithRoute _ req param = clientWithRoute (Proxy :: Proxy (QueryParam sym a :> sub)) req (Just param) instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sub) => HasDocs (RequiredQueryParam sym a :> sub) where docsFor _ (endpoint, action) =@@ -92,47 +102,8 @@ where subP = Proxy :: Proxy sub paramP = Proxy :: Proxy (QueryParam sym a)- action' = over params (|> toParam paramP) action---- | SMSAero sender's signature. This is used for the "from" field.-newtype Signature = Signature { getSignature :: Text } deriving (Eq, Show, FromJSON, ToJSON, ToText, FromText)---- | SMSAero sent message id.-newtype MessageId = MessageId Int64 deriving (Eq, Show, FromJSON, ToJSON, ToText, FromText)---- | SMSAero message body.-newtype MessageBody = MessageBody Text deriving (Eq, Show, FromJSON, ToJSON, ToText, FromText)---- | SMSAero authentication data.-data SMSAeroAuth = SMSAeroAuth- { authUser :: Text -- ^ Username.- , authPassword :: Text -- ^ MD5 hash of a password.- }--instance FromJSON SMSAeroAuth where- parseJSON (Object o) = SMSAeroAuth- <$> o .: "user"- <*> o .: "password"- parseJSON _ = empty--instance ToJSON SMSAeroAuth where- toJSON SMSAeroAuth{..} = object- [ "user" .= authUser- , "password" .= authPassword ]---- | Phone number.-newtype Phone = Phone { getPhone :: Int64 } deriving (Eq, Show, ToText, FromText)---- | Date. Textually @SMSAeroDate@ is represented as a number of seconds since 01 Jan 1970.-newtype SMSAeroDate = SMSAeroDate { getSMSAeroDate :: UTCTime } deriving (Eq, Show)--instance ToText SMSAeroDate where- toText (SMSAeroDate dt) = Text.pack (show (utcTimeToPOSIXSeconds dt))--instance FromText SMSAeroDate where- fromText s = do- n <- fromInteger <$> readMaybe (Text.unpack s)- return (SMSAeroDate (posixSecondsToUTCTime n))+ action' = action { _params = params' }+ params' = _params action ++ [toParam paramP] -- | SMSAero authentication credentials. data RequireAuth@@ -140,13 +111,12 @@ instance HasClient sub => HasClient (RequireAuth :> sub) where type Client (RequireAuth :> sub) = SMSAeroAuth -> Client sub - clientWithRoute _ req baseurl SMSAeroAuth{..} =+ clientWithRoute _ req SMSAeroAuth{..} = clientWithRoute (Proxy :: Proxy (RequiredQueryParam "user" Text :> RequiredQueryParam "password" Text :> sub)) req- baseurl authUser authPassword @@ -163,14 +133,15 @@ ["5f4dcc3b5aa765d61d8327deb882cf99", "d8578edf8458ce06fbc5bb76a58c5ca4"] "MD5 hash of a password." Normal- action' = over params ((|> passP) . (|> userP)) action+ action' = action { _params = params' }+ params' = _params action ++ [userP, passP] -- | Implicit parameter that tells SMSAero to respond with JSON. data AnswerJson instance HasClient sub => HasClient (AnswerJson :> sub) where type Client (AnswerJson :> sub) = Client sub- clientWithRoute _ req baseurl = clientWithRoute (Proxy :: Proxy (RequiredQueryParam "answer" Text :> sub)) req baseurl "json"+ clientWithRoute _ req = clientWithRoute (Proxy :: Proxy (RequiredQueryParam "answer" Text :> sub)) req "json" instance HasDocs sub => HasDocs (AnswerJson :> sub) where docsFor _ (endpoint, action) = docsFor subP (endpoint, action')@@ -180,25 +151,34 @@ ["json"] "When present makes SMSAero REST API to respond with JSON." Normal- action' = over params (|> answerP) action+ action' = action { _params = params' }+ params' = _params action ++ [answerP] -- | Regular SMSAero GET API. type SmsAeroGet a = Get '[SmsAeroJson] (SmsAeroResponse a) -- | SMSAero API. type SMSAeroAPI = RequireAuth :> AnswerJson :>- ("send" :> SendApi- :<|> "status" :> StatusApi- :<|> "balance" :> SmsAeroGet BalanceResponse- :<|> "senders" :> SmsAeroGet SendersResponse- :<|> "sign" :> SmsAeroGet SignResponse)+ ("send" :> SendApi+ :<|> "sendtogroup" :> SendToGroupApi+ :<|> "status" :> StatusApi+ :<|> "checksending" :> CheckSendingApi+ :<|> "balance" :> SmsAeroGet BalanceResponse+ :<|> "checktarif" :> SmsAeroGet CheckTariffResponse+ :<|> "senders" :> SmsAeroGet SendersResponse+ :<|> "sign" :> SmsAeroGet SignResponse+ :<|> GroupApi+ :<|> PhoneApi+ :<|> "addblacklist" :> BlacklistApi) -- | SMSAero API to send a message. type SendApi = RequiredQueryParam "to" Phone :> RequiredQueryParam "text" MessageBody :> RequiredQueryParam "from" Signature :>- QueryParam "date" SMSAeroDate :>+ QueryParam "date" SMSAeroDate :>+ QueryParam "type" SendType :>+ QueryParam "digital" DigitalChannel :> SmsAeroGet SendResponse instance ToParam (QueryParam "to" Phone) where@@ -221,10 +201,38 @@ instance ToParam (QueryParam "date" SMSAeroDate) where toParam _ = DocQueryParam "date"- [show (utcTimeToPOSIXSeconds (UTCTime (fromGregorian 2015 01 31) 0))]+ [Text.unpack (toQueryParam (SMSAeroDate (UTCTime (fromGregorian 2015 01 31) 0)))] "Requested datetime of delivery as number of seconds since 01 Jan 1970." Normal +instance ToParam (QueryParam "type" SendType) where+ toParam _ = DocQueryParam "type"+ (map (Text.unpack . toQueryParam) [minBound..maxBound::SendType])+ "Send type to describe send channel, equals to '2' (free literal signature for all operators except MTS) by default. Can't be used with 'digital' parameter."+ Normal++instance ToParam (QueryParam "digital" DigitalChannel) where+ toParam _ = DocQueryParam "digital"+ [Text.unpack (toQueryParam DigitalChannel)]+ "Send type for digital send channel. Can't be used with 'type' parameter."+ Normal++-- | SMSAero API to send a group message.+type SendToGroupApi =+ RequiredQueryParam "group" Group :>+ RequiredQueryParam "text" MessageBody :>+ RequiredQueryParam "from" Signature :>+ QueryParam "date" SMSAeroDate :>+ QueryParam "type" SendType :>+ QueryParam "digital" DigitalChannel :>+ SmsAeroGet SendResponse++instance ToParam (QueryParam "group" Group) where+ toParam _ = DocQueryParam "group"+ ["all", "groupname"]+ "Group name to broadcast a message."+ Normal+ -- | SMSAero API to check message status. type StatusApi = RequiredQueryParam "id" MessageId :> SmsAeroGet MessageStatus @@ -234,6 +242,31 @@ "Message ID, returned previously by SMSAero." Normal +-- | SMSAero API to check broadcast status.+type CheckSendingApi = RequiredQueryParam "id" MessageId :> SmsAeroGet CheckSendingResponse++-- | SMSAero API to add/delete groups.+type GroupApi =+ "checkgroup" :> SmsAeroGet [Group]+ :<|> "addgroup" :> RequiredQueryParam "group" Group :> SmsAeroGet GroupResponse+ :<|> "delgroup" :> RequiredQueryParam "group" Group :> SmsAeroGet GroupResponse++-- | SMSAero API to add/delete subscribers.+type PhoneApi =+ "addphone" :>+ RequiredQueryParam "phone" Phone :>+ QueryParam "group" Group :>+ QueryParam "lname" Name :>+ QueryParam "fname" Name :>+ QueryParam "sname" Name :>+ QueryParam "bday" BirthDate :>+ QueryParam "param" Text :>+ SmsAeroGet PhoneResponse+ :<|> "delphone" :> RequiredQueryParam "phone" Phone :> QueryParam "group" Group :> SmsAeroGet PhoneResponse++-- | SMSAero API to add phone to blacklist.+type BlacklistApi = RequiredQueryParam "phone" Phone :> SmsAeroGet BlacklistResponse+ -- | Every SMSAero response is either rejected or provides some info. data SmsAeroResponse a = ResponseOK a -- ^ Some useful payload.@@ -246,7 +279,7 @@ | SendNoCredits -- ^ No credits to send a message. deriving (Eq, Show, Generic) -instance ToSample (SmsAeroResponse SendResponse) (SmsAeroResponse SendResponse) where+instance ToSample (SmsAeroResponse SendResponse) where toSamples _ = [ ("When message is sent successfully.", ResponseOK (SendAccepted (MessageId 12345))) , ("When SMSAero account does not have enough credit.", ResponseOK SendNoCredits)@@ -262,26 +295,30 @@ | StatusWaitStatus -- ^ Wait for message status. deriving (Eq, Enum, Bounded, Show, Read, Generic) -instance ToSample (SmsAeroResponse MessageStatus) (SmsAeroResponse MessageStatus) where+instance ToSample (SmsAeroResponse MessageStatus) where toSamples _ = [ ("When message has been delivered successfully.", ResponseOK StatusDeliverySuccess) , ("When message has been queued.", ResponseOK StatusQueue) ] --- | SMSAero response to a balance request.--- This is a number of available messages to send.+-- | SMSAero response to a balance request (balance in rubles). newtype BalanceResponse = BalanceResponse Double deriving (Eq, Show) -instance ToSample (SmsAeroResponse BalanceResponse) (SmsAeroResponse BalanceResponse) where+instance ToSample (SmsAeroResponse BalanceResponse) where toSamples _ = [ ("Just balance.", ResponseOK (BalanceResponse 247)) , ("When auth credentials are incorrect.", ResponseReject "incorrect user or password") ] --- | SMSAero response to a senders request.+-- | SMSAero response to a checktarif request.+type CheckTariffResponse = Map ChannelName Double++-- | SMSAero response to a checksending request.+type CheckSendingResponse = Map MessageId MessageStatus+ -- This is just a list of available signatures. newtype SendersResponse = SendersResponse [Signature] deriving (Eq, Show, FromJSON, ToJSON) -instance ToSample (SmsAeroResponse SendersResponse) (SmsAeroResponse SendersResponse) where- toSample _ = Just (ResponseOK (SendersResponse [Signature "TEST", Signature "My Company"]))+instance ToSample (SmsAeroResponse SendersResponse) where+ toSamples _ = singleSample (ResponseOK (SendersResponse [Signature "TEST", Signature "My Company"])) -- | SMSAero response to a sign request. data SignResponse@@ -290,11 +327,20 @@ | SignPending -- ^ Signature is pending. deriving (Eq, Enum, Bounded, Show, Generic) -instance ToSample (SmsAeroResponse SignResponse) (SmsAeroResponse SignResponse) where+instance ToSample (SmsAeroResponse SignResponse) where toSamples _ = [ ("When a new signature is approved.", ResponseOK SignApproved) , ("When a new signature is rejected.", ResponseOK SignRejected) ] +-- | SMSAero response to an addgroup/delgroup request.+newtype GroupResponse = GroupResponse Text deriving (Eq, Show, FromJSON, ToJSON)++-- | SMSAero response to an addphone/delphone request.+newtype PhoneResponse = PhoneResponse Text deriving (Eq, Show, FromJSON, ToJSON)++-- | SMSAero response to an addblacklist request.+newtype BlacklistResponse = BlacklistResponse Text deriving (Eq, Show, FromJSON, ToJSON)+ instance FromJSON a => FromJSON (SmsAeroResponse a) where parseJSON (Object o) = do result :: Maybe Text <- o .:? "result"@@ -325,32 +371,27 @@ toJSON SendNoCredits = object [ "result" .= ("no credits" :: Text)] --- | Helper to define @fromText@ matching @toText@.-boundedFromText :: (Enum a, Bounded a, ToText a) => Text -> Maybe a-boundedFromText = flip lookup xs- where- vals = [minBound..maxBound]- xs = zip (map toText vals) vals--instance FromText MessageStatus where- fromText = boundedFromText+instance FromHttpApiData MessageStatus where+ parseQueryParam = parseBoundedQueryParam -instance ToText MessageStatus where- toText StatusDeliverySuccess = "delivery success"- toText StatusDeliveryFailure = "delivery failure"- toText StatusSmscSubmit = "smsc submit"- toText StatusSmscReject = "smsc reject"- toText StatusQueue = "queue"- toText StatusWaitStatus = "wait status"+instance ToHttpApiData MessageStatus where+ toQueryParam StatusDeliverySuccess = "delivery success"+ toQueryParam StatusDeliveryFailure = "delivery failure"+ toQueryParam StatusSmscSubmit = "smsc submit"+ toQueryParam StatusSmscReject = "smsc reject"+ toQueryParam StatusQueue = "queue"+ toQueryParam StatusWaitStatus = "wait status" instance FromJSON MessageStatus where parseJSON (Object o) = do result :: Text <- o .: "result"- maybe empty pure (fromText result)+ case (parseUrlPiece result :: Either Text MessageStatus) of+ Left _ -> empty+ Right status -> return status parseJSON _ = empty instance ToJSON MessageStatus where- toJSON status = object [ "result" .= toText status ]+ toJSON status = object [ "result" .= toUrlPiece status ] instance FromJSON BalanceResponse where parseJSON (Object o) = BalanceResponse <$> o .: "balance"@@ -359,19 +400,31 @@ instance ToJSON BalanceResponse where toJSON (BalanceResponse n) = object [ "balance" .= n ] -instance ToText SignResponse where- toText SignApproved = "approved"- toText SignRejected = "rejected"- toText SignPending = "pending"+instance ToHttpApiData SignResponse where+ toQueryParam SignApproved = "approved"+ toQueryParam SignRejected = "rejected"+ toQueryParam SignPending = "pending" -instance FromText SignResponse where- fromText = boundedFromText+instance FromHttpApiData SignResponse where+ parseQueryParam = parseBoundedQueryParam instance FromJSON SignResponse where parseJSON (Object o) = do accepted :: Text <- o .: "accepted"- maybe empty pure (fromText accepted)+ case (parseUrlPiece accepted :: Either Text SignResponse) of+ Left _ -> empty+ Right resp -> return resp parseJSON _ = empty instance ToJSON SignResponse where- toJSON s = object [ "accepted" .= toText s ]+ toJSON s = object [ "accepted" .= toUrlPiece s ]++instance ToJSON CheckSendingResponse where+ toJSON = toJSON . Map.mapKeys toQueryParam . fmap toQueryParam++instance FromJSON CheckSendingResponse where+ parseJSON js =+ Map.fromList . catMaybes . map dist . map (parseQueryParamMaybe *** parseQueryParamMaybe) . Map.toList <$> parseJSON js+ where+ dist (x, y) = (,) <$> x <*> y+
src/SMSAero/Client.hs view
@@ -6,40 +6,150 @@ -- Stability : experimental -- -- SMSAero HTTP servant client and individual client functions.-module SMSAero.Client where--import Control.Monad.Trans.Either+module SMSAero.Client (+ -- * Client+ smsAeroClient,+ defaultBaseUrl,+ SmsAero,+ -- * Sending a message+ smsAeroSend,+ smsAeroSendToGroup,+ -- * Checking status+ smsAeroStatus,+ smsAeroCheckSending,+ -- * Checking balance and tariff+ smsAeroBalance,+ smsAeroCheckTariff,+ -- * Signatures+ smsAeroSenders,+ smsAeroSign,+ -- * Groups+ smsAeroListGroups,+ smsAeroAddGroup,+ smsAeroDeleteGroup,+ -- * Contacts+ smsAeroAddPhone,+ smsAeroDeletePhone,+ -- * Blacklist+ smsAeroAddToBlacklist,+) where import Data.Proxy+import Data.Text (Text) import Servant.API import Servant.Client import SMSAero.API-import SMSAero.Utils+import SMSAero.Types +import Network.HTTP.Client (Manager)+ -- | SMSAero client. smsAeroClient :: Client SMSAeroAPI-smsAeroClient = client (Proxy :: Proxy SMSAeroAPI) host- where- host = BaseUrl Https "gate.smsaero.ru" 443+smsAeroClient = client (Proxy :: Proxy SMSAeroAPI) +-- | Default host @https://gate.smsaero.ru@.+defaultBaseUrl :: BaseUrl+defaultBaseUrl = BaseUrl Https "gate.smsaero.ru" 443 ""+ -- | Common SMSAero client type.-type SmsAero a = EitherT ServantError IO (SmsAeroResponse a)+type SmsAero a = Manager -> BaseUrl -> ClientM (SmsAeroResponse a) -- | Send a message.-smsAeroSend :: SMSAeroAuth -> Phone -> MessageBody -> Signature -> Maybe SMSAeroDate -> SmsAero SendResponse+smsAeroSend :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> Phone -- ^ Phone number to send a message to.+ -> MessageBody -- ^ Message text.+ -> Signature -- ^ Sender's signature used for the "from" field.+ -> Maybe SMSAeroDate -- ^ Date stating when to send a postponed message.+ -> Maybe SendType -- ^ Send channel description.+ -> Maybe DigitalChannel -- ^ Use digital send channel.+ -> SmsAero SendResponse++-- | Send a group message.+smsAeroSendToGroup :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> Group -- ^ Group name for broadcasting a message.+ -> MessageBody -- ^ Message text.+ -> Signature -- ^ Sender's signature used for the "from" field.+ -> Maybe SMSAeroDate -- ^ Date stating when to send a postponed message.+ -> Maybe SendType -- ^ Send channel description.+ -> Maybe DigitalChannel -- ^ Use digital send channel.+ -> SmsAero SendResponse+ -- | Check status of a previously sent message.-smsAeroStatus :: SMSAeroAuth -> MessageId -> SmsAero MessageStatus+smsAeroStatus :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> MessageId -- ^ Message ID.+ -> SmsAero MessageStatus++-- | Check status of a broadcast.+smsAeroCheckSending :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> MessageId -- ^ Broadcast ID.+ -> SmsAero CheckSendingResponse+ -- | Check balance.-smsAeroBalance :: SMSAeroAuth -> SmsAero BalanceResponse+smsAeroBalance :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> SmsAero BalanceResponse++-- | Check tariff.+smsAeroCheckTariff :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> SmsAero CheckTariffResponse+ -- | Check the list of available sender signatures.-smsAeroSenders :: SMSAeroAuth -> SmsAero SendersResponse+smsAeroSenders :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> SmsAero SendersResponse+ -- | Acquire a new signature.-smsAeroSign :: SMSAeroAuth -> SmsAero SignResponse-(smsAeroSend :<|>- smsAeroStatus :<|>- smsAeroBalance :<|>- smsAeroSenders :<|>- smsAeroSign) = distributeClient smsAeroClient+smsAeroSign :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> SmsAero SignResponse++-- | Get groups list (corresponds to 'checkgroup' endpoint).+smsAeroListGroups :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> SmsAero [Group]++-- | Add a group.+smsAeroAddGroup :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> Group -- ^ Name for the new group.+ -> SmsAero GroupResponse++-- | Delete a group.+smsAeroDeleteGroup :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> Group -- ^ Name of the group to be deleted.+ -> SmsAero GroupResponse++-- | Add a phone to contact list or group.+smsAeroAddPhone :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> Phone -- ^ Subscriber's phone number.+ -> Maybe Group -- ^ Contact group. If absent, contact will be added to general contact list.+ -> Maybe Name -- ^ Subscriber's last name.+ -> Maybe Name -- ^ Subscriber's first name.+ -> Maybe Name -- ^ Subscriber's middle name.+ -> Maybe BirthDate -- ^ Subscriber's birth date.+ -> Maybe Text -- ^ Any additional information.+ -> SmsAero PhoneResponse++-- | Delete a phone from contact list or group.+smsAeroDeletePhone :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password).+ -> Phone -- ^ Subscriber's phone number.+ -> Maybe Group -- ^ Group to remove contact from. If absent, contact will be deleted from general contact list.+ -> SmsAero PhoneResponse++-- | Add a phone number to blacklist.+smsAeroAddToBlacklist :: SMSAeroAuth -- ^ Authentication data (login and MD5 hash of password)+ -> Phone -- ^ Phone number to be added to blacklist.+ -> SmsAero BlacklistResponse++smsAeroSend auth = let (f :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroSendToGroup auth = let (_ :<|> f :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroStatus auth = let (_ :<|> _ :<|> f :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroCheckSending auth = let (_ :<|> _ :<|> _ :<|> f :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroBalance auth = let (_ :<|> _ :<|> _ :<|> _ :<|> f :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroCheckTariff auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> f :<|> _ :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroSenders auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> f :<|> _ :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroSign auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> f :<|> _ :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroListGroups auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> (f :<|> _ :<|> _) :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroAddGroup auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> (_ :<|> f :<|> _) :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroDeleteGroup auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> (_ :<|> _ :<|> f) :<|> _ :<|> _) = smsAeroClient auth in f+smsAeroAddPhone auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> (f :<|> _) :<|> _) = smsAeroClient auth in f+smsAeroDeletePhone auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> (_ :<|> f) :<|> _) = smsAeroClient auth in f+smsAeroAddToBlacklist auth = let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> f) = smsAeroClient auth in f
+ src/SMSAero/Types.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : SMSAero.Types+-- Copyright : (c) 2016, GetShopTV+-- License : BSD3+-- Maintainer : nickolay@getshoptv.com+-- Stability : experimental+--+-- This module defines types used in SMSAero API.+module SMSAero.Types (+ SMSAeroAuth(..),+ Signature(..),+ MessageId(..),+ MessageBody(..),+ Group(..),+ Phone(..),+ SMSAeroDate(..),+ SendType(..),+ DigitalChannel(..),+ Name(..),+ BirthDate(..),+ ChannelName,+) where++import Control.Applicative (empty)++import Data.Aeson+import Data.Int (Int64)++import Data.Time (UTCTime)+import Data.Time.Calendar (Day)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)++import Data.Text (Text)+import qualified Data.Text as Text++import Web.HttpApiData.Internal++-- | SMSAero sender's signature. This is used for the "from" field.+newtype Signature = Signature { getSignature :: Text } deriving (Eq, Show, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData)++-- | SMSAero sent message id.+newtype MessageId = MessageId Int64 deriving (Eq, Show, Ord, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData)++-- | SMSAero message body.+newtype MessageBody = MessageBody Text deriving (Eq, Show, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData)++-- | SMSAero group name.+newtype Group = Group Text deriving (Eq, Show, FromJSON, ToJSON, ToHttpApiData, FromHttpApiData)++-- | SMSAero channel name.+type ChannelName = Text++-- | SMSAero authentication data.+data SMSAeroAuth = SMSAeroAuth+ { authUser :: Text -- ^ Username.+ , authPassword :: Text -- ^ MD5 hash of a password.+ }++instance FromJSON SMSAeroAuth where+ parseJSON (Object o) = SMSAeroAuth+ <$> o .: "user"+ <*> o .: "password"+ parseJSON _ = empty++instance ToJSON SMSAeroAuth where+ toJSON SMSAeroAuth{..} = object+ [ "user" .= authUser+ , "password" .= authPassword ]++-- | Phone number.+newtype Phone = Phone { getPhone :: Int64 } deriving (Eq, Show, ToHttpApiData, FromHttpApiData)++-- | Date. Textually @SMSAeroDate@ is represented as a number of seconds since 01 Jan 1970.+newtype SMSAeroDate = SMSAeroDate { getSMSAeroDate :: UTCTime } deriving (Eq, Show)++instance ToHttpApiData SMSAeroDate where+ toQueryParam (SMSAeroDate dt) = Text.pack (show (utcTimeToPOSIXSeconds dt))++instance FromHttpApiData SMSAeroDate where+ parseQueryParam s = do+ n <- fromInteger <$> parseQueryParam s+ return (SMSAeroDate (posixSecondsToUTCTime n))++-- | Send type. This is used to describe send channel, equals to @FreeSignatureExceptMTC@ by default.+-- Textually @SendType@ is represented as a number from 1 to 6, excluding 5.+data SendType+ = PaidSignature -- ^ Paid literal signature for all operators.+ | FreeSignatureExceptMTC -- ^ Free literal signature for all operators except MTS.+ | FreeSignature -- ^ Free literal signature for all operators.+ | InfoSignature -- ^ Infosignature for all operators.+ | International -- ^ International delivery (for RU and KZ operators).+ deriving (Eq, Show, Bounded, Enum)++-- | Digital send channel. Textually represented as '1' if the parameter is present.+data DigitalChannel = DigitalChannel++instance ToHttpApiData DigitalChannel where+ toQueryParam _ = "1"++instance FromHttpApiData DigitalChannel where+ parseQueryParam "1" = Right DigitalChannel+ parseQueryParam x = defaultParseError x++instance ToHttpApiData SendType where+ toQueryParam PaidSignature = "1"+ toQueryParam FreeSignatureExceptMTC = "2"+ toQueryParam FreeSignature = "3"+ toQueryParam InfoSignature = "4"+ toQueryParam International = "6"++instance FromHttpApiData SendType where+ parseQueryParam = parseBoundedQueryParam++-- | Subscriber's name.+newtype Name = Name Text deriving (Eq, Show, ToHttpApiData, FromHttpApiData)++-- | Subscriber's birth date. Textually represented in %Y-%m-%d format.+newtype BirthDate = BirthDate Day deriving (Eq, Show, ToHttpApiData, FromHttpApiData)+
− src/SMSAero/Utils.hs
@@ -1,44 +0,0 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--- |--- Module : SMSAero.Utils--- Copyright : (c) 2015, GetShopTV--- License : BSD3--- Maintainer : nickolay@getshoptv.com--- Stability : experimental------ This module defines @'DistributiveClient'@ class--- to help distribute functions over alternatives (@':<|>'@).-module SMSAero.Utils where--import Servant.API.Alternative---- | Distribute a client looking like------ @--- a -> (b ':<|>' ... ':<|>' c)--- @------ into------ @--- (a -> b) ':<|>' ... ':<|>' (a -> c)--- @------ This is useful to bring authentication credentials to--- individual client endpoint queries.-class DistributiveClient client client' where- distributeClient :: client -> client'---- | Base case.-instance DistributiveClient (a -> b) (a -> b) where- distributeClient = id---- | Distribute function over alternative.-instance (DistributiveClient (a -> b) b', DistributiveClient (a -> c) c') => DistributiveClient (a -> (b :<|> c)) (b' :<|> c') where- distributeClient client = distributeClient (fmap left client) :<|> distributeClient (fmap right client)- where- left (l :<|> _) = l- right (_ :<|> r) = r