[TSD-50] Fix Zendesk URL parameters. (#20)

* [TSD-50] Fix Zendesk URL parameters.

* [TSD-50] Fix review comment.

Author: ksaric

.gitignore

@@ -20,6 +20,7 @@ wallet-db/
 wallet-new-db/
 db-*/
 wdb-*/
+*.db
 
 # Keys
 *.key

src/DataSource/DB.hs

@@ -156,7 +156,6 @@ getTicketComments ticketId = do
     getCommentAttachments commentId = withProdDatabase $ \conn ->
         queryNamed conn "SELECT * FROM comment_attachments WHERE comment_id = :id" [":id" := commentId]
 
-
 getAttachmentContent :: Attachment -> IO (Maybe AttachmentContent)
 getAttachmentContent Attachment{..} = withProdDatabase $ \conn ->
     safeHead <$> queryNamed conn "SELECT * FROM attachment_content WHERE attachment_id = :id" [":id" := aId]

src/DataSource/Http.hs

@@ -20,10 +20,10 @@ import           Network.HTTP.Simple (Request, addRequestHeader, getResponseBody
 
 import           DataSource.Types (Attachment (..), AttachmentContent (..), Comment (..),
                                    CommentBody (..), CommentId (..), Config (..), IOLayer (..),
-                                   Ticket (..), TicketId(..), TicketInfo (..), TicketList (..),
-                                   TicketTag (..), User, UserId(..), ZendeskLayer (..),
-                                   ZendeskResponse (..), parseComments, parseTickets, parseTicket,
-                                   renderTicketStatus)
+                                   Ticket (..), TicketId (..), TicketInfo (..), TicketList (..),
+                                   TicketTag (..), User, UserId (..), ZendeskAPIUrl (..),
+                                   ZendeskLayer (..), ZendeskResponse (..), parseComments,
+                                   parseTicket, parseTickets, renderTicketStatus, showURL)
 
 
 -- | The default configuration.
@@ -80,7 +80,8 @@ getTicketInfo
 getTicketInfo ticketId = do
     cfg <- ask
 
-    let req = apiRequest cfg ("tickets/" <> show (getTicketId ticketId) <> ".json")
+    let url = showURL $ TicketsURL ticketId
+    let req = apiRequest cfg url
     liftIO $ Just <$> apiCall parseTicket req
 
 
@@ -92,8 +93,8 @@ listRequestedTickets
 listRequestedTickets userId = do
     cfg <- ask
 
-    let url     = "/users/" <> show (getUserId userId) <> "/tickets/requested.json"
-    let req     = apiRequest cfg url
+    let url = showURL $ UserRequestedTicketsURL userId
+    let req = apiRequest cfg url
 
     iterateTicketPages req
 
@@ -105,8 +106,8 @@ listAssignedTickets
 listAssignedTickets userId = do
     cfg <- ask
 
-    let url     = "/users/" <> show (getUserId userId) <> "/tickets/assigned.json"
-    let req     = apiRequest cfg url
+    let url = showURL $ UserAssignedTicketsURL userId
+    let req = apiRequest cfg url
 
     iterateTicketPages req
 
@@ -139,7 +140,8 @@ postTicketComment
 postTicketComment ZendeskResponse{..} = do
     cfg <- ask
 
-    let req1 = apiRequest cfg ("tickets/" <> show zrTicketId <> ".json")
+    let url  = showURL $ TicketsURL zrTicketId
+    let req1 = apiRequest cfg url
     let req2 = addJsonBody
                    (Ticket
                        (Comment (CommentId 0) (CommentBody $ "**Log classifier**\n\n" <> zrComment) [] zrIsPublic (cfgAgentId cfg))
@@ -155,7 +157,10 @@ _getUser
     => m User
 _getUser = do
     cfg <- ask
-    let req = apiRequest cfg "users/me.json"
+
+    let url = showURL UserInfoURL
+    let req = apiRequest cfg url
+
     liftIO $ apiCall parseJSON req
 
 -- | Given attachmentUrl, return attachment in bytestring
@@ -175,7 +180,10 @@ getTicketComments
     -> m [Comment]
 getTicketComments tId = do
     cfg <- ask
-    let req = apiRequest cfg ("tickets/" <> show (getTicketId tId) <> "/comments.json")
+
+    let url = showURL $ TicketCommentsURL tId
+    let req = apiRequest cfg url
+
     liftIO $ apiCall parseComments req
 
 ------------------------------------------------------------

src/DataSource/Types.hs

@@ -39,6 +39,8 @@ module DataSource.Types
     , assignToPath
     , asksZendeskLayer
     , asksIOLayer
+    , ZendeskAPIUrl (..)
+    , showURL
     , App
     , runApp
     ) where
@@ -144,6 +146,43 @@ data IOLayer m = IOLayer
     , iolReadFile               :: FilePath -> m String
     }
 
+------------------------------------------------------------
+-- Class and instances to display in URL
+------------------------------------------------------------
+
+-- Let's keep this simple for now. Not much use for it now since
+-- we can't simply extend it using @ZendeskAPIUrl@, but let's worry
+-- about that later.
+class ToURL a where
+    toURL :: a -> Text
+
+instance ToURL UserId where
+    toURL (UserId uId) = show uId
+
+instance ToURL TicketId where
+    toURL (TicketId ticketId) = show ticketId
+
+data ZendeskAPIUrl
+    = UserRequestedTicketsURL UserId
+    | UserAssignedTicketsURL UserId
+    | TicketsURL TicketId
+    | TicketAgentURL TicketId
+    | UserInfoURL
+    | TicketCommentsURL TicketId
+    deriving (Eq, Generic)
+
+showURL :: ZendeskAPIUrl -> Text
+showURL (UserRequestedTicketsURL userId)    = "/users/" <> toURL userId <> "/tickets/requested.json"
+showURL (UserAssignedTicketsURL userId)     = "/users/" <> toURL userId <> "/tickets/assigned.json"
+showURL (TicketsURL ticketId)               = "/tickets/" <> toURL ticketId <> ".json"
+showURL (TicketAgentURL ticketId)           = "https://iohk.zendesk.com/agent/tickets/" <> toURL ticketId
+showURL (UserInfoURL)                       = "/users/me.json"
+showURL (TicketCommentsURL ticketId)        = "/tickets/" <> toURL ticketId <> "/comments.json"
+
+------------------------------------------------------------
+-- Types
+------------------------------------------------------------
+
 newtype AttachmentId = AttachmentId
     { getAttachmentId :: Int
     } deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON)
@@ -279,12 +318,12 @@ newtype TicketStatus = TicketStatus
 
 
 data TicketInfo = TicketInfo
-    { tiId          :: !TicketId     -- ^ Id of an ticket
-    , tiRequesterId :: !UserId       -- ^ Id of the requester
-    , tiAssigneeId  :: Maybe UserId  -- ^ Id of the asignee
-    , tiUrl         :: !TicketURL    -- ^ The ticket URL
-    , tiTags        :: !TicketTags   -- ^ Tags associated with ticket
-    , tiStatus      :: !TicketStatus -- ^ The status of the ticket
+    { tiId          :: !TicketId        -- ^ Id of an ticket
+    , tiRequesterId :: !UserId          -- ^ Id of the requester
+    , tiAssigneeId  :: !(Maybe UserId)  -- ^ Id of the asignee
+    , tiUrl         :: !TicketURL       -- ^ The ticket URL
+    , tiTags        :: !TicketTags      -- ^ Tags associated with ticket
+    , tiStatus      :: !TicketStatus    -- ^ The status of the ticket
     } deriving (Eq, Show, Generic)
 
 

src/LogAnalysis/Classifier.hs

@@ -18,8 +18,8 @@ import qualified Data.Map.Strict as Map
 import           Data.Text (isInfixOf)
 import           Data.Text.Encoding.Error (ignore)
 
+import           DataSource.Types (TicketInfo (..), ZendeskAPIUrl (..), showURL)
 import           LogAnalysis.Types (Analysis, Knowledge (..), renderErrorCode)
-import           DataSource.Types (TicketInfo (..))
 
 -- | Number of error texts it should show
 numberOfErrorText :: Int
@@ -57,10 +57,6 @@ filterAnalysis as = do
 extractErrorCodes :: Analysis -> [ Text ]
 extractErrorCodes as = map (\(Knowledge{..}, _) -> renderErrorCode kErrorCode) $ Map.toList as
 
-
-printTicketUrl :: TicketInfo -> Text
-printTicketUrl TicketInfo{..} = "https://iohk.zendesk.com/agent/tickets/" <> show tiId
-
 prettyHeader :: Text
 prettyHeader =
     "Dear user," <>
@@ -72,7 +68,7 @@ prettyHeader =
 prettyFooter :: TicketInfo -> Text
 prettyFooter ticketInfo =
     "\n\n" <>
-        "Please be patient since we have a large number of such requests to respond to. We will respond as soon as we can, but in the meantime, if you want to check the status of your ticket you can do so here - " <> printTicketUrl ticketInfo <>
+        "Please be patient since we have a large number of such requests to respond to. We will respond as soon as we can, but in the meantime, if you want to check the status of your ticket you can do so here - " <> (showURL $ TicketAgentURL $ tiId ticketInfo) <>
     "\n\n" <>
     "Please let us know if your issue is resolved. If you are still having trouble please reply back to this email and attach a new log file so that we can work with you to fix your problem." <>
     "\n\n" <>
@@ -108,13 +104,13 @@ prettyFormatLogReadError ticketInfo =
 prettyFormatNoLogs :: Text
 prettyFormatNoLogs =
     "Dear user," <> "\n\n" <>
-    "Thank you for contacting the IOHK Technical Support Desk. We apologize for the delay in responding to you." <> "\n\n" <> 
+    "Thank you for contacting the IOHK Technical Support Desk. We apologize for the delay in responding to you." <> "\n\n" <>
     "Most of the tickets we get are related to technical issues. If you have a Technical problem with Daedalus wallet please read on. If your request is NOT related to getting technical support you can IGNORE this email." <> "\n\n" <>
     "We have recently (May 29th) had a major update to the Daedalus software. You can see more details here https://daedaluswallet.io/release-notes/. If you are experiencing any technical difficulties please make sure you have upgraded to the latest version before submitting a request for support or submitting new logs (more on logs below)." <> "\n\n" <>
     "We scan our tickets to check for known issues before responding in person. If you have a technical issue but did not submit a log file we suggest that you reply to this message and attach your log file. Log files are required for helping with the majority of technical issues." <> "\n\n" <>
-    
+
     "Please provide more information so that we can diagnose your issue:" <> "\n\n" <>
-    
+
     "1. What is the Manufacturer and the Model number of your computer?" <> "\n" <>
     "2. What is the Type and Version of the Operation System (OS) are you using?" <> "\n" <>
     "3. Describe the issue you are experiencing in detail and attach screenshots if needed. Please tell us what you were doing when the error occurred." <> "\n" <>
@@ -123,15 +119,15 @@ prettyFormatNoLogs =
     "Please compress and attach your pub folder, it contains technical logs. There is NO sensitive data in your logs:" <> "\n\n" <>
 
     "Windows" <> "\n\n" <>
-    
+
     "1. Go to" <> "\n" <>
     "C:\\Users'username\\AppData\\Roaming\\Daedalus\\Logs" <> "\n" <>
     "You can access them by typing %appdata% into Windows Explorer search bar." <> "\n" <>
     "2. Compress the pub folder into a Zip file." <> "\n" <>
     "3. Attach the compressed pub folder to your reply." <> "\n\n" <>
-    
+
     "Mac" <> "\n\n" <>
-    
+
     "1. Open Finder" <> "\n" <>
     "2. Go to the Menu Bar and select the 'Go' menu" <> "\n" <>
     "3. Select 'Go to Folder...'" <> "\n" <>
@@ -142,4 +138,4 @@ prettyFormatNoLogs =
 
     "Thanks," <> "\n" <>
     "The IOHK Technical Support Desk Team"
-    
+

test/Spec.hs

@@ -4,12 +4,13 @@ import           Universum
 
 import           Test.Hspec (Spec, describe, hspec, it, pending)
 import           Test.Hspec.QuickCheck (modifyMaxSuccess)
-import           Test.QuickCheck (Gen, arbitrary, forAll, listOf1)
+import           Test.QuickCheck (Gen, arbitrary, forAll, listOf1, property)
 import           Test.QuickCheck.Monadic (assert, monadicIO, pre, run)
 
-import           DataSource (App, Comment (..), Config (..), IOLayer (..), TicketInfo (..),
-                             ZendeskLayer (..), ZendeskResponse (..), basicIOLayer, defaultConfig,
-                             emptyZendeskLayer, runApp)
+import           DataSource (App, Comment (..), Config (..), IOLayer (..), TicketId (..),
+                             TicketInfo (..), UserId (..), ZendeskAPIUrl (..), ZendeskLayer (..),
+                             ZendeskResponse (..), basicIOLayer, defaultConfig, emptyZendeskLayer,
+                             runApp, showURL)
 import           Lib (listAndSortTickets, processTicket)
 
 -- TODO(ks): What we are really missing is a realistic @Gen ZendeskLayer m@.
@@ -21,6 +22,7 @@ main = hspec spec
 spec :: Spec
 spec =
     describe "Zendesk" $ do
+        validShowURLSpec
         listAndSortTicketsSpec
         processTicketSpec
 
@@ -218,3 +220,34 @@ processTicketsSpec =
     describe "processTickets" $ do
         it "doesn't process tickets" $ do
             pending
+
+-- Simple tests to cover it works.
+validShowURLSpec :: Spec
+validShowURLSpec =
+    describe "showURL" $ modifyMaxSuccess (const 10000) $ do
+        it "returns valid UserRequestedTicketsURL" $ do
+            property $ \userId ->
+                let typedURL    = showURL $ UserRequestedTicketsURL userId
+                    untypedURL  = "/users/" <> show (getUserId userId) <> "/tickets/requested.json"
+                in  typedURL == untypedURL
+        it "returns valid UserAssignedTicketsURL" $ do
+            property $ \userId ->
+                let typedURL    = showURL $ UserAssignedTicketsURL userId
+                    untypedURL  = "/users/" <> show (getUserId userId) <> "/tickets/assigned.json"
+                in  typedURL == untypedURL
+        it "returns valid TicketsURL" $ do
+            property $ \ticketId ->
+                let typedURL    = showURL $ TicketsURL ticketId
+                    untypedURL  = "/tickets/" <> show (getTicketId ticketId) <> ".json"
+                in  typedURL == untypedURL
+        it "returns valid TicketAgentURL" $ do
+            property $ \ticketId ->
+                let typedURL    = showURL $ TicketAgentURL ticketId
+                    untypedURL  = "https://iohk.zendesk.com/agent/tickets/" <> show (getTicketId ticketId)
+                in  typedURL == untypedURL
+        it "returns valid TicketCommentsURL" $ do
+            property $ \ticketId ->
+                let typedURL    = showURL $ TicketCommentsURL ticketId
+                    untypedURL  = "/tickets/" <> show (getTicketId ticketId) <> "/comments.json"
+                in  typedURL == untypedURL
+