From c3f36a0179aae650d8b9ddcf13adb73eb559c6e2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jan=20Hamal=20Dvo=C5=99=C3=A1k?= <mordae@anilinux.org>
Date: Tue, 8 Jun 2021 13:55:59 +0200
Subject: [PATCH] Implement contact database
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Signed-off-by: Jan Hamal Dvořák <mordae@anilinux.org>
---
README.md | 29 ++++++++++++++
sql/013-contacts.sql | 48 +++++++++++++++++++++++
src/Pelican/API.hs | 91 +++++++++++++++++++++++++++++++++++++++-----
src/Pelican/Types.hs | 16 +++++---
4 files changed, 169 insertions(+), 15 deletions(-)
create mode 100644 sql/013-contacts.sql
diff --git a/README.md b/README.md
index cbe6f59..8171cf9 100644
--- a/README.md
+++ b/README.md
@@ -107,6 +107,35 @@ V historii zpráv tak v příkladu výše zůstane pouze text _"Váš PIN je $$.
- V případě chyby je kód odpovědi z řad 400 nebo 500 a tělo obsahuje vysvětlení. U chyb na straně klienta (400) je tělo zpravidla typu `text/plain` a obsahuje krátký popis problému.
+### Odeslání SMS zprávy kontaktu
+
+```http
+POST /v1/send/to-contact HTTP/1.1
+Content-Type: application/json
+
+{
+ "application": "přidělené <appid>",
+ "token": "přidělený přístupový <token>",
+ "contact": "<název> kontaktu",
+ "payload": "Váš PIN je $$. Piráti",
+ "interpolate": ["1234"],
+ "receipt": "volitelné <uuid> pro kontrolu doručení",
+ "centre": "volitelný <název> nákladového střediska",
+ "billing": "bill-sender|bill-recipient"
+}
+```
+
+```http
+HTTP/1.1 202 Accepted
+Content-Type: text/plain; charset=utf8
+```
+
+Funguje obdobně jako `/v1/send/to-number` s následujícími rozdíly:
+
+- Namísto číslo příjemce se použije název kontaktu. Například `uid:jan.hamal.dvorak`, `forum:410` nebo `sso:b503b712-9f7c-4479-a1dd-e7b6447dc2cb`. Záleží jaké kontakty jsou v DB definovány.
+- Je nutné uvést pole `billing`; hodnota `bill-sender` účtuje zprávu na vrub nákladového střediska uvedeného v poli `centre` (které je možné vynechat pro výchozí účtování na vrub aplikace); naopak `bill-recipient` účtuje zprávu na vrub nákladového střediska příjemce.
+
+
### Kontrola doručenky
```http
diff --git a/sql/013-contacts.sql b/sql/013-contacts.sql
new file mode 100644
index 0000000..552e7c4
--- /dev/null
+++ b/sql/013-contacts.sql
@@ -0,0 +1,48 @@
+-- In order to be able to reach people without necessary knowing their
+-- numbers and to be able to bill recipient cost centre, create an
+-- address book of sorts.
+
+create table contact (
+ -- Boring primary key.
+ id bigserial not null primary key,
+
+ -- Arbitrary user identifier string for the API.
+ userid varchar not null,
+
+ -- Phone number of the contact for the Sender.
+ number varchar not null,
+
+ -- Cost centre of the user for billing.
+ cost_centre varchar not null collate "und-x-icu",
+
+ -- Replication & other metadata.
+ meta jsonb not null default '{}',
+
+ -- User identifiers are unique, but numbers can repeat.
+ unique(userid)
+);
+
+-- Make sure we don't point outside of the cost_centre table.
+alter table contact add constraint contact_cost_centre_fkey
+ foreign key (cost_centre)
+ references cost_centre (name)
+ on delete restrict
+ on update cascade;
+
+-- Speed up some metadata-based searches.
+create index contact_meta_idx on contact
+ using gin (meta jsonb_path_ops);
+
+-- Add billing method for recipients.
+alter type billing_method add value 'bill-recipient';
+
+-- Allow applications to use more billing methods at once.
+alter table application
+ add column billing_methods billing_method[] not null default '{}';
+
+update application set billing_methods = ARRAY[billing];
+
+alter table application drop column billing;
+
+-- Add a column to history for posterity when sending to contacts.
+alter table history add column userid varchar;
diff --git a/src/Pelican/API.hs b/src/Pelican/API.hs
index 4759620..9e0478f 100644
--- a/src/Pelican/API.hs
+++ b/src/Pelican/API.hs
@@ -33,6 +33,7 @@ where
route getReceiptR
route getReceiptsR
route postSendToNumberR
+ route postSendToContactR
newtype ParamUUID = ParamUUID UUID
@@ -53,7 +54,7 @@ where
where
handle = do
-- Read the request. Automatically dies on parsing error.
- SendToNumbers{..} <- getJSON
+ SendToNumber{..} <- getJSON
-- Check that the application is allowed to be billed.
checkBilling BillSender application token
@@ -86,8 +87,8 @@ where
sendText ""
- data SendToNumbers
- = SendToNumbers
+ data SendToNumber
+ = SendToNumber
{ number :: PhoneNumber
, payload :: Text
, interpolate :: Maybe (Vector Text)
@@ -98,7 +99,77 @@ where
}
deriving (Show, Generic)
- instance FromJSON SendToNumbers
+ instance FromJSON SendToNumber
+
+
+ postSendToContactR :: Route '[] (Action ())
+ postSendToContactR = post handle // "v1" // "send" // "to-contact"
+ /? acceptJSON /? offerText
+ where
+ handle = do
+ -- Read the request. Automatically dies on parsing error.
+ SendToContact{..} <- getJSON
+
+ -- Check that the application is allowed to bill in specified way.
+ checkBilling billing application token
+
+ -- Check that the application has not yet exceeded its daily quota.
+ checkQuota application
+
+ case centre of
+ Nothing -> return ()
+ Just cc -> checkCostCentre cc
+
+ -- Find the recipient.
+ contacts <- query [sql| select number, cost_centre from contact
+ where userid = ? |] (Only contact)
+
+ -- Find the contact or fail.
+ (number :: PhoneNumber, ccid :: Text) <-
+ case contacts of
+ [] -> abort badRequest400 [] "Contact not found."
+ c:_ -> return c
+
+ -- Respect specified billing method.
+ let centre' = case billing of
+ BillSender -> centre
+ BillRecipient -> Just ccid
+
+ handlePgErrors pgConflict ["23505"] do
+ -- Proceed to insert the message into the history and queue.
+ Only (historyId :: Int64) <- do
+ query1 [sql| insert into history (appid, payload, number, receipt,
+ cost_centre, userid)
+ values (?, ?, ?, ?, ?, ?) returning id |]
+ (application, payload, number, receipt, centre', contact)
+
+ execute_ [sql| insert into queue (history, payload)
+ values (?, ?) |]
+ (historyId, interpolated payload interpolate)
+
+ -- Notify our sender thread.
+ execute_ [sql| notify send |] ()
+
+ -- We set 202 status to indicate that nothing is certain at this point.
+ -- The gateway may yet reject the message.
+ setStatus status202
+ sendText ""
+
+
+ data SendToContact
+ = SendToContact
+ { contact :: Text
+ , payload :: Text
+ , interpolate :: Maybe (Vector Text)
+ , receipt :: Maybe UUID
+ , application :: Text
+ , token :: Text
+ , centre :: Maybe Text
+ , billing :: Bill
+ }
+ deriving (Show, Generic)
+
+ instance FromJSON SendToContact
interpolated :: Text -> Maybe (Vector Text) -> Text
@@ -203,15 +274,17 @@ where
checkBilling :: Bill -> Text -> Text -> Action ()
checkBilling needed appid token = do
- billings <- fmap (fmap fromOnly) do
- query [sql| select billing from application
+ methods' <- fmap (fmap fromOnly) do
+ query [sql| select billing_methods from application
where appid = ? and token = ? |] (appid, token)
- when (billings == []) do
+ when (methods' == []) do
abort unauthorized401 [] "Your application is not properly registered."
- unless (needed `elem` billings) do
- abort forbidden403 [] ("Requires " <> tshow needed <> " billing method.")
+ let methods = mconcat methods' :: Vector Bill
+
+ unless (needed `elem` methods) do
+ abort forbidden403 [] (tshow needed <> " not allowed for your app.")
checkQuota :: Text -> Action ()
diff --git a/src/Pelican/Types.hs b/src/Pelican/Types.hs
index 780a356..4523b39 100644
--- a/src/Pelican/Types.hs
+++ b/src/Pelican/Types.hs
@@ -37,15 +37,18 @@ where
data Bill
= BillSender
+ | BillRecipient
deriving (Eq, Show, Ord, Enum, Bounded)
instance FromJSON Bill where
parseJSON = withText "Bill" \case
- "bill-sender" -> return BillSender
- _otherwise -> fail "invalid Bill format"
+ "bill-sender" -> return BillSender
+ "bill-recipient" -> return BillRecipient
+ _otherwise -> fail "invalid Bill format"
instance ToField Bill where
- toField BillSender = Escape "bill-sender"
+ toField BillSender = Escape "bill-sender"
+ toField BillRecipient = Escape "bill-recipient"
instance FromField Bill where
fromField f mdata = do
@@ -53,9 +56,10 @@ where
if type' /= "billing_method"
then returnError Incompatible f ""
else case fmap cs mdata of
- Nothing -> returnError UnexpectedNull f ""
- Just "bill-sender" -> return BillSender
- Just x -> returnError ConversionFailed f x
+ Nothing -> returnError UnexpectedNull f ""
+ Just "bill-sender" -> return BillSender
+ Just "bill-recipient" -> return BillRecipient
+ Just x -> returnError ConversionFailed f x
-- vim:set ft=haskell sw=2 ts=2 et:
--
GitLab