packages feed

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       
               ]