syncthing-hs-0.2.0.0: tests/Properties/JsonInstances.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
module Properties.JsonInstances where
import Control.Applicative ((<$>), pure)
import Data.Aeson hiding (Error)
import Data.Maybe (fromMaybe, maybeToList)
import Data.Scientific (scientific)
import qualified Data.Text as T
import qualified Data.Vector as V
import Network.Syncthing.Internal
singleField :: ToJSON a => T.Text -> a -> Value
singleField fieldName = object . pure . (fieldName .=)
encodeMaybe = fromMaybe ""
encodeUTC = encodeMaybe . fmap fromUTC
encodeInvalid = encodeMaybe . fmap T.unpack
encodeModelState = encodeMaybe . fmap encodeState
where encodeState state =
case state of
Idle -> "idle"
Scanning -> "scanning"
Cleaning -> "cleaning"
Syncing -> "syncing"
instance ToJSON Version where
toJSON Version{..} =
object [ "arch" .= getArch
, "longVersion" .= getLongVersion
, "os" .= getOs
, "version" .= getVersion
]
instance ToJSON Ping where
toJSON = singleField "ping" . getPing
instance ToJSON Completion where
toJSON = singleField "completion" . getCompletion
instance ToJSON Sync where
toJSON = singleField "configInSync" . getSync
instance ToJSON CacheEntry where
toJSON CacheEntry{..} =
object [ "Address" .= encodeAddr getAddr
, "Seen" .= encodeUTC getSeen
]
instance ToJSON Connection where
toJSON Connection{..} =
object [ "at" .= encodeUTC getAt
, "inBytesTotal" .= getInBytesTotal
, "outBytesTotal" .= getOutBytesTotal
, "address" .= encodeAddr getAddress
, "clientVersion" .= getClientVersion
]
instance ToJSON Connections where
toJSON Connections{..} =
object [ "connections" .= getConnections
, "total" .= getTotal
]
instance ToJSON Model where
toJSON Model{..} =
object [ "globalBytes" .= getGlobalBytes
, "globalDeleted" .= getGlobalDeleted
, "globalFiles" .= getGlobalFiles
, "inSyncBytes" .= getInSyncBytes
, "inSyncFiles" .= getInSyncFiles
, "localBytes" .= getLocalBytes
, "localDeleted" .= getLocalDeleted
, "localFiles" .= getLocalFiles
, "needBytes" .= getNeedBytes
, "needFiles" .= getNeedFiles
, "state" .= encodeModelState getState
, "stateChanged" .= encodeUTC getStateChanged
, "invalid" .= encodeInvalid getInvalid
, "version" .= getModelVersion
]
instance ToJSON Upgrade where
toJSON Upgrade{..} =
object [ "latest" .= getLatest
, "newer" .= getNewer
, "running" .= getRunning
]
instance ToJSON Ignore where
toJSON Ignore{..} =
object [ "ignore" .= getIgnores
, "patterns" .= getPatterns
]
instance ToJSON Need where
toJSON Need{..} =
object [ "progress" .= getProgress
, "queued" .= getQueued
, "rest" .= getRest
]
instance ToJSON FileInfo where
toJSON FileInfo{..} =
object $ [ "name" .= getName
, "flags" .= getFlags
, "modified" .= encodeUTC getModified
, "version" .= getFileVersion
, "localVersion" .= getLocalVersion
, "size" .= getSize
]
++ maybeToList (("numBlocks" .=) <$> getNumBlocks)
instance ToJSON DBFile where
toJSON DBFile{..} =
object [ "availability" .= getAvailability
, "global" .= getGlobal
, "local" .= getLocal
]
instance ToJSON System where
toJSON System{..} =
object [ "alloc" .= getAlloc
, "cpuPercent" .= getCpuPercent
, "extAnnounceOK" .= getExtAnnounceOK
, "goroutines" .= getGoRoutines
, "myID" .= getMyId
, "sys" .= getSys
, "pathSeparator" .= getPathSeparator
, "tilde" .= getTilde
, "uptime" .= getUptime
]
instance ToJSON (Either DeviceError Device) where
toJSON = object . pure . either deviceError deviceId
where deviceError = ("error" .=) . encodeDeviceError
deviceId = ("id" .=)
encodeDeviceError :: DeviceError -> T.Text
encodeDeviceError err =
case err of
IncorrectLength -> "device ID invalid: incorrect length"
IncorrectCheckDigit -> "check digit incorrect"
OtherDeviceError e -> e
instance ToJSON SystemMsg where
toJSON msg = object [ "ok" .= decodedSystemMsg ]
where
decodedSystemMsg = case msg of
Restarting -> "restarting"
ShuttingDown -> "shutting down"
ResettingFolders -> "resetting folders"
OtherSystemMsg m -> m
instance ToJSON Error where
toJSON Error{..} =
object [ "time" .= encodeUTC getTime
, "error" .= getMsg
]
instance ToJSON Errors where
toJSON = singleField "errors" . getErrors
instance ToJSON DeviceInfo where
toJSON DeviceInfo{..} = object [ "lastSeen" .= encodeUTC getLastSeen ]
instance ToJSON FolderInfo where
toJSON FolderInfo{..} = object [ "lastFile" .= getLastFile ]
instance ToJSON LastFile where
toJSON LastFile{..} =
object [ "filename" .= getFileName
, "at" .= encodeUTC getSyncedAt
]
instance ToJSON DirTree where
toJSON Dir{..} = toJSON getDirContents
toJSON File{..} = Array $ V.fromList [modTime, fileSize]
where
modTime = String . T.pack . encodeUTC $ getModTime
fileSize = Number $ scientific getFileSize 0
instance ToJSON UsageReport where
toJSON UsageReport{..} =
object [ "folderMaxFiles" .= getFolderMaxFiles
, "folderMaxMiB" .= getFolderMaxMiB
, "longVersion" .= getLongVersionR
, "memorySize" .= getMemorySize
, "memoryUsageMiB" .= getMemoryUsageMiB
, "numDevices" .= getNumDevices
, "numFolders" .= getNumFolders
, "platform" .= getPlatform
, "sha256Perf" .= getSHA256Perf
, "totFiles" .= getTotFiles
, "totMiB" .= getTotMiB
, "uniqueID" .= getUniqueId
, "version" .= getVersionR
]