Advertisement
NLinker

Ntf IO test 2

Jul 28th, 2017
451
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# LANGUAGE FlexibleContexts    #-}
  2. {-# LANGUAGE OverloadedStrings   #-}
  3. {-# LANGUAGE ScopedTypeVariables #-}
  4.  
  5. module VertigoIO.TestMain where
  6.  
  7. import Control.Lens                 ((&), (.~), (?~), (^.))
  8. import Control.Monad                (liftM)
  9. import Control.Monad.Catch          (MonadCatch, MonadThrow)
  10. import Control.Monad.IO.Class       (MonadIO, liftIO)
  11. import Control.Monad.Trans.AWS      (runAWST)
  12. import Control.Monad.Trans.Control  (MonadBaseControl)
  13. import Control.Monad.Trans.Either   (EitherT, runEitherT)
  14. import Control.Monad.Trans.Maybe    (MaybeT)
  15. import Control.Monad.Trans.Reader   (ReaderT, ask, runReaderT)
  16. import Control.Monad.Trans.Resource (ResourceT(..), runResourceT)
  17. import Data.Aeson                   (decode, encode)
  18. import Data.Conduit                 (Consumer, await, awaitForever, ($$), ($$+-), (=$))
  19. import Data.Conduit.Binary          (sinkFile, sinkHandle)
  20. import Data.Foldable                (forM_)
  21. import Data.Text.Encoding           (encodeUtf8)
  22. import Network.AWS
  23. import Network.AWS.SNS
  24. import Network.HTTP                 (getResponseBody)
  25. import Network.HTTP.Client          (Manager)
  26. import Network.HTTP.Conduit         (checkStatus, http, httpLbs, method, newManager, parseUrl,
  27.                                      redirectCount, requestHeaders, responseBody, simpleHttp,
  28.                                      tlsManagerSettings, withManager)
  29. import System.IO                    (stdout)
  30.  
  31. import Vertigo.AppM
  32. import Vertigo.Ext
  33. import Vertigo.Types.Config
  34. import Vertigo.Types.DeviceInfo
  35. import Vertigo.Types.Error
  36. import Vertigo.Web
  37.  
  38. import qualified Data.ByteString.Char8          as B
  39. import qualified Data.ByteString.Lazy.Char8     as LB
  40. import qualified Data.Text                      as T
  41. import qualified Data.UUID                      as U
  42. import qualified Data.UUID.V4                   as U
  43. import qualified Vertigo.Types.Notification     as N
  44. import qualified Vertigo.Types.Notification.Ids as N
  45.  
  46. ----------------------------
  47. import Debug.Trace
  48. import Helper.Str
  49.  
  50. ----------------------------------------------
  51. -- TODO make tests with assertions, not prints
  52. ----------------------------------------------
  53.  
  54. ------------------------------------------------------------------------------
  55. -- | test encode/decode NotificationType
  56. test01 :: IO ()
  57. test01 = do
  58.   let l = [General, Social, Search, Sync]
  59.   let encl = map encode l
  60.   print encl
  61.   -- prepend one wrong entry and decode
  62.   let decl = map dent ("Junk" : encl)
  63.   print decl
  64.   where
  65.      dent x = decode x :: Maybe NotificationType
  66.  
  67. ------------------------------------------------------------------------------
  68. -- | test encode/decode Notification
  69. test02 :: IO ()
  70. test02 = do
  71.   let i = encodeUtf8 $ T.pack "06a8b2d0-b1a9-441b-9a12-e420002ab0de"
  72.   let uid = fromJust $ fromBytes i
  73.   let n = Notification uid General "Message here!" ""
  74.   -- let uid = toText "06a8b2d0-b1a9-441b-9a12-e420002ab0de"
  75.   let encN = encode n
  76.   print encN
  77.   let decN = decode encN :: Maybe Notification
  78.   print decN
  79.   let wrong = "{\"payload\":\"Payload here!\",\"notification_type\":\"Oops\",\"receiver_uid\":\"06a8b2d0-b1a9-441b-9a12-e420002ab0de\"}"
  80.   print (decode wrong :: Maybe Notification)
  81.   where
  82.     fromJust :: Maybe a -> a
  83.     fromJust Nothing  = error "Maybe.fromJust: Nothing"
  84.     fromJust (Just x) = x
  85.  
  86. --------------------------------------------------
  87. -- | Call user service and get the list of devices
  88. test03 :: IO ()
  89. test03 = do
  90.   rq0 <- parseUrl "http://user.devvmg.com/rest/device"
  91.   let accessToken = "eyJhbGciOiJIUzI1NiJ9.eyJleHAiOjE0NTMxMTQ0OTAsIlVzZXJJZCI6IjdkODk5OGNjLTkxYmEtNDhiOS05MTgzLWQ5YTdiYjg2NDI2NSIsImlhdCI6MTQ0NzkzMDQ5MCwic3ViIjoibWFjMiIsIkVtYWlsIjoidXNlckBob3N0LmNvbSJ9.ylnyUVdG6J0zkMK9vnqEJo55-FKeYbw2zq11xC9Hhvg"
  92.   let req = rq0 {
  93.       redirectCount = 0
  94.     , requestHeaders = ("X-Access-Token", accessToken): (requestHeaders rq0)
  95.     }
  96.   traceM $ "req=" ++ show req
  97.   manager <- newManager tlsManagerSettings
  98.   let stdOutSink :: (Show a) => Consumer a (ResourceT IO) ()
  99.       stdOutSink = awaitForever $ liftIO . print
  100.   runResourceT $ do
  101.     res <- http req manager
  102.     responseBody res $$+- stdOutSink --sinkFile "output.txt"
  103.  
  104. --------------------------------------------------
  105. -- | Publish message to Amazon SNS
  106. -- Analog in scala:
  107. --  sns.publish(new PublishRequest
  108. --   .withTargetArn "arn:aws:sns:us-west-2:877422789438:endpoint/GCM/nicks-notify-app/56aff09d-1878-3f7f-bae0-2cd31c7cba4c"
  109. --   .withMessage "{\"GCM\":\"{\"data\":{\"message\":\"Hello, Nick!\"}}\"}"
  110. -- )
  111. test05 :: IO ()
  112. test05 = do
  113.   let conf = buildConfig LOCAL
  114.   ext <- buildEnvironmentExt conf
  115.   (_, msg, targetArn) <- mySnsData
  116.   mgr <- newManager tlsManagerSettings
  117.   liftAppToIO ext $ snsPublish0 msg targetArn
  118.   print "Message sent"
  119.  
  120. instance Show Env where
  121.   show e = "envRegion=" ++ show (e ^. envRegion)
  122.  
  123. mySnsData :: (MonadIO m, MonadCatch m) => m (Env, T.Text, T.Text)
  124. mySnsData = do
  125.   e <- newEnv Oregon Discover
  126.   l <- newLogger Debug stdout
  127.   let env = e & envLogger `assign` l
  128.   let targetArn = "arn:aws:sns:us-west-2:876422789438:endpoint/GCM/nicks-notify-app/56aff09d-1878-3f7f-bae0-2cd31c7cba4c"
  129.   let msg = "{\"GCM\":\"{\"data\":{\"message\":\"Hello, Nick!\"}}\"}"
  130.   return (env, msg, targetArn)
  131.   where
  132.     assign = (.~)
  133.  
  134. ------------------------------------------------------------------------------
  135. -- | Publish message to user service
  136. -- test06 :: MaybeT IO ()
  137. test06 :: IO ()
  138. test06 = do
  139.   let token = "eyJhbGciOiJIUzI1NiJ9.eyJleHAiOjE0NTMxMTQ0OTAsIlVzZXJJZCI6IjdkODk5OGNjLTkxYmEtNDhiOS05MTgzLWQ5YTdiYjg2NDI2NSIsImlhdCI6MTQ0NzkzMDQ5MCwic3ViIjoibWFjMiIsIkVtYWlsIjoidXNlckBob3N0LmNvbSJ9.ylnyUVdG6J0zkMK9vnqEJo55-FKeYbw2zq11xC9Hhvg"
  140.   ext <- buildEnvironmentExt
  141.   let confE = ext ^. config
  142.   let mb = U.fromText "06a8b2d0-b1a9-441b-9a12-e420002ab0de"
  143.   forM_ mb $ \id ->
  144.     case confE of
  145.       Left err -> print err
  146.       Right conf -> do
  147.         let uid = UserId id
  148.         let n = Notification uid General "Hello" ""
  149.         ext <- buildExt conf
  150.         -- ask user service
  151.         manager <- newManager tlsManagerSettings
  152.         dis <- liftAppToIO ext $ userServiceGetDevices manager token uid
  153.         print dis
  154.  
  155. ------------------------------------------------------------------------------
  156. test07 :: IO ()
  157. test07 = do
  158.   let cfg = buildConfig LOCAL
  159.   ext <- buildEnvironmentExt
  160.   let deviceToken = ""
  161.   let paArn = "TODO"
  162.   ext <- buildEnvironmentExt cfg
  163.   manager <- newManager tlsManagerSettings
  164.   -- env <- newEnv Oregon Discover
  165.   logger <- newLogger Debug stdout
  166.   env <- liftM (envWithLog logger) $ newEnv Oregon Discover
  167.   resp <- liftAppToIO ext $ snsCreatePlatformEndpoint0 paArn deviceToken
  168.   print resp
  169.   where
  170.     envWithLog :: Logger -> Env -> Env
  171.     envWithLog logger env = env & envLogger .~ logger
  172.  
  173.   -- case dsMb of
  174.   --   Just ds -> return ds
  175.   --   Nothing -> return []
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement