{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module VertigoIO.TestMain where
import Control.Lens ((&), (.~), (?~), (^.))
import Control.Monad (liftM)
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.AWS (runAWST)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Either (EitherT, runEitherT)
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans.Resource (ResourceT(..), runResourceT)
import Data.Aeson (decode, encode)
import Data.Conduit (Consumer, await, awaitForever, ($$), ($$+-), (=$))
import Data.Conduit.Binary (sinkFile, sinkHandle)
import Data.Foldable (forM_)
import Data.Text.Encoding (encodeUtf8)
import Network.AWS
import Network.AWS.SNS
import Network.HTTP (getResponseBody)
import Network.HTTP.Client (Manager)
import Network.HTTP.Conduit (checkStatus, http, httpLbs, method, newManager, parseUrl,
redirectCount, requestHeaders, responseBody, simpleHttp,
tlsManagerSettings, withManager)
import System.IO (stdout)
import Vertigo.AppM
import Vertigo.Ext
import Vertigo.Types.Config
import Vertigo.Types.DeviceInfo
import Vertigo.Types.Error
import Vertigo.Web
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Text as T
import qualified Data.UUID as U
import qualified Data.UUID.V4 as U
import qualified Vertigo.Types.Notification as N
import qualified Vertigo.Types.Notification.Ids as N
----------------------------
import Debug.Trace
import Helper.Str
----------------------------------------------
-- TODO make tests with assertions, not prints
----------------------------------------------
------------------------------------------------------------------------------
-- | test encode/decode NotificationType
test01 :: IO ()
test01 = do
let l = [General, Social, Search, Sync]
let encl = map encode l
print encl
-- prepend one wrong entry and decode
let decl = map dent ("Junk" : encl)
print decl
where
dent x = decode x :: Maybe NotificationType
------------------------------------------------------------------------------
-- | test encode/decode Notification
test02 :: IO ()
test02 = do
let i = encodeUtf8 $ T.pack "06a8b2d0-b1a9-441b-9a12-e420002ab0de"
let uid = fromJust $ fromBytes i
let n = Notification uid General "Message here!" ""
-- let uid = toText "06a8b2d0-b1a9-441b-9a12-e420002ab0de"
let encN = encode n
print encN
let decN = decode encN :: Maybe Notification
print decN
let wrong = "{\"payload\":\"Payload here!\",\"notification_type\":\"Oops\",\"receiver_uid\":\"06a8b2d0-b1a9-441b-9a12-e420002ab0de\"}"
print (decode wrong :: Maybe Notification)
where
fromJust :: Maybe a -> a
fromJust Nothing = error "Maybe.fromJust: Nothing"
fromJust (Just x) = x
--------------------------------------------------
-- | Call user service and get the list of devices
test03 :: IO ()
test03 = do
rq0 <- parseUrl "http://user.devvmg.com/rest/device"
let accessToken = "eyJhbGciOiJIUzI1NiJ9.eyJleHAiOjE0NTMxMTQ0OTAsIlVzZXJJZCI6IjdkODk5OGNjLTkxYmEtNDhiOS05MTgzLWQ5YTdiYjg2NDI2NSIsImlhdCI6MTQ0NzkzMDQ5MCwic3ViIjoibWFjMiIsIkVtYWlsIjoidXNlckBob3N0LmNvbSJ9.ylnyUVdG6J0zkMK9vnqEJo55-FKeYbw2zq11xC9Hhvg"
let req = rq0 {
redirectCount = 0
, requestHeaders = ("X-Access-Token", accessToken): (requestHeaders rq0)
}
traceM $ "req=" ++ show req
manager <- newManager tlsManagerSettings
let stdOutSink :: (Show a) => Consumer a (ResourceT IO) ()
stdOutSink = awaitForever $ liftIO . print
runResourceT $ do
res <- http req manager
responseBody res $$+- stdOutSink --sinkFile "output.txt"
--------------------------------------------------
-- | Publish message to Amazon SNS
-- Analog in scala:
-- sns.publish(new PublishRequest
-- .withTargetArn "arn:aws:sns:us-west-2:877422789438:endpoint/GCM/nicks-notify-app/56aff09d-1878-3f7f-bae0-2cd31c7cba4c"
-- .withMessage "{\"GCM\":\"{\"data\":{\"message\":\"Hello, Nick!\"}}\"}"
-- )
test05 :: IO ()
test05 = do
let conf = buildConfig LOCAL
ext <- buildEnvironmentExt conf
(_, msg, targetArn) <- mySnsData
mgr <- newManager tlsManagerSettings
liftAppToIO ext $ snsPublish0 msg targetArn
print "Message sent"
instance Show Env where
show e = "envRegion=" ++ show (e ^. envRegion)
mySnsData :: (MonadIO m, MonadCatch m) => m (Env, T.Text, T.Text)
mySnsData = do
e <- newEnv Oregon Discover
l <- newLogger Debug stdout
let env = e & envLogger `assign` l
let targetArn = "arn:aws:sns:us-west-2:876422789438:endpoint/GCM/nicks-notify-app/56aff09d-1878-3f7f-bae0-2cd31c7cba4c"
let msg = "{\"GCM\":\"{\"data\":{\"message\":\"Hello, Nick!\"}}\"}"
return (env, msg, targetArn)
where
assign = (.~)
------------------------------------------------------------------------------
-- | Publish message to user service
-- test06 :: MaybeT IO ()
test06 :: IO ()
test06 = do
let token = "eyJhbGciOiJIUzI1NiJ9.eyJleHAiOjE0NTMxMTQ0OTAsIlVzZXJJZCI6IjdkODk5OGNjLTkxYmEtNDhiOS05MTgzLWQ5YTdiYjg2NDI2NSIsImlhdCI6MTQ0NzkzMDQ5MCwic3ViIjoibWFjMiIsIkVtYWlsIjoidXNlckBob3N0LmNvbSJ9.ylnyUVdG6J0zkMK9vnqEJo55-FKeYbw2zq11xC9Hhvg"
ext <- buildEnvironmentExt
let confE = ext ^. config
let mb = U.fromText "06a8b2d0-b1a9-441b-9a12-e420002ab0de"
forM_ mb $ \id ->
case confE of
Left err -> print err
Right conf -> do
let uid = UserId id
let n = Notification uid General "Hello" ""
ext <- buildExt conf
-- ask user service
manager <- newManager tlsManagerSettings
dis <- liftAppToIO ext $ userServiceGetDevices manager token uid
print dis
------------------------------------------------------------------------------
test07 :: IO ()
test07 = do
let cfg = buildConfig LOCAL
ext <- buildEnvironmentExt
let deviceToken = ""
let paArn = "TODO"
ext <- buildEnvironmentExt cfg
manager <- newManager tlsManagerSettings
-- env <- newEnv Oregon Discover
logger <- newLogger Debug stdout
env <- liftM (envWithLog logger) $ newEnv Oregon Discover
resp <- liftAppToIO ext $ snsCreatePlatformEndpoint0 paArn deviceToken
print resp
where
envWithLog :: Logger -> Env -> Env
envWithLog logger env = env & envLogger .~ logger
-- case dsMb of
-- Just ds -> return ds
-- Nothing -> return []
Comments