Merge pull request haskell-servant#24 from wireapp/update-brig-types

[brig-types] import updates

libs/brig-types/brig-types.cabal

@@ -15,6 +15,7 @@ library
 
     exposed-modules:
         Brig.Types
+        Brig.Types.AddressBook
         Brig.Types.Activation
         Brig.Types.Client
         Brig.Types.Client.Prekey
@@ -29,13 +30,15 @@ library
         Brig.Types.Swagger
         Brig.Types.User
         Brig.Types.User.Auth
+        Brig.Types.Search
 
     default-language:   Haskell2010
 
     build-depends:
         aeson                 >= 0.11
       , attoparsec            >= 0.10
       , base                  == 4.*
+      , base64-bytestring     >= 1.0
       , bytestring            >= 0.9
       , bytestring-conversion >= 0.2
       , containers            >= 0.5

libs/brig-types/src/Brig/Types.hs

@@ -1,7 +1,9 @@
 module Brig.Types (module M) where
 
-import Brig.Types.Activation as M
-import Brig.Types.Client     as M
-import Brig.Types.Connection as M
-import Brig.Types.Properties as M
-import Brig.Types.User       as M
+import Brig.Types.Activation  as M
+import Brig.Types.AddressBook as M
+import Brig.Types.Client      as M
+import Brig.Types.Connection  as M
+import Brig.Types.Properties  as M
+import Brig.Types.Search      as M
+import Brig.Types.User        as M

libs/brig-types/src/Brig/Types/AddressBook.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+module Brig.Types.AddressBook
+    ( module Brig.Types.AddressBook
+    ) where
+
+import Data.Aeson
+import Data.ByteString (ByteString)
+import Data.Id
+import Data.Json.Util
+import Data.Text (Text)
+
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.Text.Encoding     as T
+
+newtype CardId = CardId Text
+    deriving (Eq, Show, Ord, FromJSON, ToJSON)
+
+-- The base64-encoded SHA-256 of an email address or a phone number
+newtype Entry = Entry { abEntrySha256 :: ByteString }
+    deriving (Eq, Show, Ord)
+
+instance FromJSON Entry where
+    parseJSON = withText "Entry" $
+        either (fail "Invalid Entry") (pure . Entry) . (B64.decode . T.encodeUtf8)
+
+-- Used only in tests but defined here to avoid orphan
+instance ToJSON Entry where
+    toJSON = String . T.decodeUtf8 . B64.encode . abEntrySha256
+
+data Card = Card
+    { cCardId  :: !(Maybe CardId) -- Random card identifier, defined by clients
+    , cEntries :: ![Entry]
+    } deriving (Eq, Show)
+
+instance FromJSON Card where
+    parseJSON = withObject "matching-card" $ \o ->
+        Card  <$> o .:? "card_id"
+              <*> o .:  "contact"
+
+instance ToJSON Card where
+    toJSON c = object
+        [ "card_id" .= cCardId c
+        , "contact" .= cEntries c
+        ]
+
+newtype AddressBook = AddressBook
+    { abCards :: [Card]
+    } deriving (Eq, Show)
+
+instance FromJSON AddressBook where
+    parseJSON = withObject "address-book" $ \o ->
+        AddressBook <$> o .: "cards"
+
+instance ToJSON AddressBook where
+    toJSON ab = object
+        [ "cards" .= abCards ab
+        ]
+
+-- V3 result
+
+data Match = Match
+    { mUser   :: !UserId
+    , mCardId :: !(Maybe CardId) -- Card id that was matched (Deprecated!)
+    , mCards  :: ![CardId]       -- List of card ids matched
+    } deriving (Eq, Ord, Show)
+
+instance FromJSON Match where
+    parseJSON = withObject "match" $ \o ->
+        Match <$> o .:  "id"
+              <*> o .:? "card_id"
+              <*> o .:? "cards" .!= []
+
+instance ToJSON Match where
+    toJSON m = object
+        $ "id"      .= mUser m
+        # "card_id" .= mCardId m
+        # "cards"   .= mCards m
+        # []
+
+data MatchingResult = MatchingResult
+    { mrMatches :: ![Match]
+    , mrAuto    :: ![UserId]
+    } deriving (Eq, Ord, Show)
+
+instance FromJSON MatchingResult where
+    parseJSON = withObject "matches" $ \o ->
+        MatchingResult <$> o .: "results"
+                       <*> o .: "auto-connects"
+
+instance ToJSON MatchingResult where
+    toJSON r = object
+        [ "results"       .= mrMatches r
+        , "auto-connects" .= mrAuto r
+        ]
+

libs/brig-types/src/Brig/Types/Provider/External.hs

@@ -98,18 +98,21 @@ data BotUserView = BotUserView
     { botUserViewId     :: !UserId
     , botUserViewName   :: !Name
     , botUserViewColour :: !ColourId
-    }
+    , botUserViewHandle :: !(Maybe Handle)
+    } deriving (Eq, Show)
 
 instance FromJSON BotUserView where
     parseJSON = withObject "BotUserView" $ \o ->
-        BotUserView <$> o .: "id"
-                    <*> o .: "name"
-                    <*> o .: "accent_id"
+        BotUserView <$> o .:  "id"
+                    <*> o .:  "name"
+                    <*> o .:  "accent_id"
+                    <*> o .:? "handle"
 
 instance ToJSON BotUserView where
     toJSON u = object
         [ "id"        .= botUserViewId u
         , "name"      .= botUserViewName u
         , "accent_id" .= botUserViewColour u
+        , "handle"    .= botUserViewHandle u
         ]
 

libs/brig-types/src/Brig/Types/Search.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData        #-}
+
+module Brig.Types.Search where
+
+import Data.Aeson
+import Data.Id        (UserId)
+import Data.Json.Util
+import Data.Text      (Text)
+
+
+data SearchResult a = SearchResult
+    { searchFound    :: Int
+    , searchReturned :: Int
+    , searchTook     :: Int
+    , searchResults  :: [a]
+    } deriving Show
+
+data Contact = Contact
+    { contactUserId  :: UserId
+    , contactName    :: Text
+    , contactColorId :: Maybe Int
+    , contactHandle  :: Maybe Text
+    } deriving Show
+
+-- | Encodes whether the (current) user has opted in/out of search
+newtype SearchableStatus = SearchableStatus { isSearchable :: Bool }
+    deriving Show
+
+
+instance ToJSON a => ToJSON (SearchResult a) where
+    toJSON r = object
+        [ "found"     .= searchFound r
+        , "returned"  .= searchReturned r
+        , "took"      .= searchTook r
+        , "documents" .= searchResults r
+        ]
+
+instance FromJSON a => FromJSON (SearchResult a) where
+    parseJSON = withObject "SearchResult" $ \o ->
+        SearchResult <$> o .: "found"
+                     <*> o .: "returned"
+                     <*> o .: "took"
+                     <*> o .: "documents"
+
+instance ToJSON Contact where
+    toJSON c = object
+        $ "id"        .= contactUserId c
+        # "name"      .= contactName c
+        # "accent_id" .= contactColorId c
+        # "handle"    .= contactHandle c
+        # []
+
+instance FromJSON Contact where
+    parseJSON = withObject "Contact" $ \o ->
+        Contact <$> o .:  "id"
+                <*> o .:  "name"
+                <*> o .:? "accent_id"
+                <*> o .:? "handle"
+
+instance ToJSON SearchableStatus where
+    toJSON (SearchableStatus onoff) = object [ "searchable" .= onoff ]
+
+instance FromJSON SearchableStatus where
+    parseJSON = withObject "SearchableStatus" $
+        fmap SearchableStatus . (.: "searchable")
+

libs/brig-types/src/Brig/Types/Swagger.hs

@@ -68,8 +68,19 @@ brigModels =
     , clientPrekey
     , prekey
 
+      -- Onboarding
+    , addressBook
+    , card
+    , match
+    , onboardingMatches
+
       -- Properties
     , propertyValue
+
+      -- Search
+    , searchResult
+    , searchContact
+    , searchableStatus
     ]
 
 -------------------------------------------------------------------------------
@@ -698,3 +709,76 @@ prekey = defineModel "Prekey" $ do
 propertyValue :: Model
 propertyValue = defineModel "PropertyValue" $
     description "A property value is any valid JSON value."
+
+-----------------------------------------------------------------------------
+-- Onboarding
+
+addressBook :: Model
+addressBook = defineModel "AddressBook" $ do
+    description "Address book of a user"
+    property "cards" (array (ref card)) $
+        description "List of cards"
+
+card :: Model
+card = defineModel "Card" $ do
+    description "A contact's card"
+    property "contact" (array string') $
+        description "List of base64-encoded SHA-256 of a normalised \
+                    \email address or phone number"
+    property "card_id" string' $ do
+        description "Unique card identifier, defined by clients."
+        optional
+
+match :: Model
+match = defineModel "Match" $ do
+    description "A user that got auto-connected as a result of the upload."
+    property "id" string' $
+        description "Matched user ID"
+    property "card_id" string' $ do
+        description "DEPRECATED! Use cards instead."
+        optional
+    property "cards" (array string') $
+        description "List of card ids for this match."
+
+onboardingMatches :: Model
+onboardingMatches = defineModel "onboardingMatches" $ do
+    description "Result of the address book matching"
+    property "results" (array (ref match)) $
+        description "List of matches."
+    property "auto-connects" (array (ref match)) $
+        description "List of user IDs matched. It's a bit redudant given 'results' \
+                    \but it is here for reasons of backwards compatibility."
+
+--------------------------------------------------------------------------------
+-- Search
+
+searchResult :: Model
+searchResult = defineModel "SearchResult" $ do
+    description "Search Result"
+    property "found" int32' $
+        description "Total number of hits"
+    property "returned" int32' $
+        description "Number of hits returned"
+    property "took" int32' $
+        description "Search time in ms"
+    property "documents" (array (ref searchContact)) $
+        description "List of contacts found"
+
+searchContact :: Model
+searchContact = defineModel "Contact" $ do
+    description "Contact discovered through search"
+    property "id" string' $
+        description "User ID"
+    property "name" string' $
+        description "Name"
+    property "handle" string' $
+        description "Handle"
+    property "accent_id" int32' $ do
+        description "Accent color"
+        optional
+
+searchableStatus :: Model
+searchableStatus = defineModel "SearchableStatus" $ do
+    description "Whether the user is discoverable via search"
+    property "enabled" bool' $
+        description "'true' if discoverable, 'false' otherwise"